packages feed

swish 0.2.1 → 0.3.0.0

raw patch · 146 files changed

+31850/−39672 lines, 146 filesdep +directorydep +filepathdep +networkdep ~HUnitdep ~arraydep ~basenew-component:exe:NTTestnew-component:exe:RDFProofTestnew-uploader

Dependencies added: directory, filepath, network

Dependency ranges changed: HUnit, array, base, binary, bytestring, containers, mtl, old-time, parallel, parsec, random

Files

− Swish/HaskellRDF/BuiltInDatatypes.hs 
@@ -1,96 +0,0 @@---------------------------------------------------------------------------------
---  $Id: BuiltInDatatypes.hs,v 1.2 2003/12/18 20:46:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  BuiltInDatatypes
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module collects references and provides access to all of the
---  datatypes built in to Swish.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.BuiltInDatatypes
-    ( allDatatypes, findRDFDatatype )
-where
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..), mapFindMaybe
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-import Swish.HaskellRDF.RDFDatatypeXsdString
-    ( rdfDatatypeXsdString )
-
-import Swish.HaskellRDF.RDFDatatypeXsdInteger
-    ( rdfDatatypeXsdInteger )
-
-------------------------------------------------------------
---  Declare datatype map
-------------------------------------------------------------
-
-allDatatypes :: [RDFDatatype]
-allDatatypes =
-    [ rdfDatatypeXsdString
-    , rdfDatatypeXsdInteger
-    ]
-
-findRDFDatatype :: ScopedName -> Maybe RDFDatatype
-findRDFDatatype nam = mapFindMaybe nam (LookupMap allDatatypes)
-
-------------------------------------------------------------
---  Declare datatype subtypes map
-------------------------------------------------------------
-
-allDatatypeSubtypes :: [xxx]
-allDatatypeSubtypes = []
---  [[[details TBD]]]
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/BuiltInDatatypes.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: BuiltInDatatypes.hs,v $
--- Revision 1.2  2003/12/18 20:46:24  graham
--- Added xsd:string module to capture equivalence of xsd:string
--- and plain literals without a language tag
---
--- Revision 1.1  2003/12/17 16:56:39  graham
--- Split content of BuiltInMap into separate modules, to avoid recursive
--- module dependency with RDFProofContext.
---
− Swish/HaskellRDF/BuiltInMap.hs 
@@ -1,77 +0,0 @@---------------------------------------------------------------------------------
---  $Id: BuiltInMap.hs,v 1.5 2003/12/18 18:27:46 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  BuiltInMap
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module collects references and provides access to all of the
---  datatypes, variable binding modifiers and variable binding filters
---  built in to Swish.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.BuiltInMap
-    ( findRDFOpenVarBindingModifier
-    , findRDFDatatype
-    , rdfRulesetMap
-    , allRulesets, allDatatypeRulesets
-    )
-where
-
-import Swish.HaskellRDF.BuiltInDatatypes
-import Swish.HaskellRDF.BuiltInRules
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/BuiltInMap.hs,v $
--- $Author: graham $
--- $Revision: 1.5 $
--- $Log: BuiltInMap.hs,v $
--- Revision 1.5  2003/12/18 18:27:46  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.4  2003/12/17 16:56:39  graham
--- Split content of BuiltInMap into separate modules, to avoid recursive
--- module dependency with RDFProofContext.
---
--- Revision 1.3  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.2  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.1  2003/12/08 23:56:07  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
− Swish/HaskellRDF/BuiltInMapTest.hs 
@@ -1,299 +0,0 @@---------------------------------------------------------------------------------
---  $Id: BuiltInMapTest.hs,v 1.5 2004/01/06 13:53:10 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  BuiltInMapTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for thje funtion for accessing built-in
---  variable binding modifiers.
---
---------------------------------------------------------------------------------
-
---    WNH RIP OUT   module Swish.HaskellRDF.BuiltInMapTest where
-
-import Swish.HaskellRDF.BuiltInMap
-    ( findRDFOpenVarBindingModifier
-    , findRDFDatatype
-    , rdfRulesetMap
-    , allRulesets
-    )
-
-import Swish.HaskellRDF.RDFDatatypeXsdInteger
-    ( typeNameXsdInteger, namespaceXsdInteger
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    , getContextAxiom, getMaybeContextAxiom
-    , getContextRule,  getMaybeContextRule
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName
-    , scopeRDF
-    , scopeRDFS
-    , scopeRDFD
-    , namespaceXsdType
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( mapFindMaybe )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , Assertion
-    , assertBool, assertEqual, assertString, assertFailure
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Control.Monad
-    ( unless )
-
-import Data.List
-    ( sort, union, intersect )
-
-import Data.Maybe
-    ( isJust, fromJust, fromMaybe )
-
-
-------------------------------------------------------------
---  Test case helpers
-------------------------------------------------------------
-
-assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
-assertMember preface expected actual =
-  unless (expected `elem` actual ) (assertFailure msg)
-  where msg = (if null preface then "" else preface ++ "\n") ++
-             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
-
-test :: String -> Bool -> Test
-test lab bv =
-    TestCase ( assertBool ("test:"++lab) bv )
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
-testElem lab a1 as =
-    TestCase ( assertMember ("testElem:"++lab) a1 as )
-
-testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
-testLe lab eq a1 a2 =
-    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
-
--- Test for Just x or Nothing
-
-testJust :: String -> Maybe a -> Test
-testJust lab av =
-    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
-
-testNothing :: String -> Maybe a -> Test
-testNothing lab av =
-    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
-
--- Compare lists and lists of lists and Maybe lists for set equivalence:
-
-data ListTest a = ListTest [a]
-
-instance (Eq a) => Eq (ListTest a) where
-    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
-
-instance (Show a) => Show (ListTest a) where
-    show (ListTest a) = show a
-
-data MaybeListTest a = MaybeListTest (Maybe [a])
-
-instance (Eq a) => Eq (MaybeListTest a) where
-    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
-    MaybeListTest Nothing   == MaybeListTest Nothing   = True
-    _                       == _                       = False
-
-instance (Show a) => Show (MaybeListTest a) where
-    show (MaybeListTest a) = show a
-
-testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
-
-testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
-testEqvEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest $ map ListTest a1
-        ma2 = ListTest $ map ListTest a2
-
-testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
-testHasEqv lab a1 a2 =
-    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest a1
-        ma2 = map ListTest a2
-
-testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
-testMaybeEqv lab a1 a2 =
-    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = (MaybeListTest a1)
-        ma2 = (MaybeListTest a2)
-
-------------------------------------------------------------
---  Test finding built-in variable binding modifiers
-------------------------------------------------------------
-
-testVarMod01 = testJust "testVarMod01" $
-    findRDFOpenVarBindingModifier (swishName "rdfVarBindingUriRef")
-testVarMod02 = testJust "testVarMod02" $
-    findRDFOpenVarBindingModifier (swishName "rdfVarBindingDatatyped")
-testVarMod03 = testJust "testVarMod03" $
-    findRDFOpenVarBindingModifier (swishName "varFilterNE")
-testVarMod04 = testJust "testVarMod04" $
-    findRDFOpenVarBindingModifier (swishName "nullVarBindingModify")
-testVarMod05 = testJust "testVarMod05" $
-    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "abs")
-testVarMod06 = testJust "testVarMod06" $
-    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "divmod")
-testVarMod07 = testJust "testVarMod07" $
-    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "ge")
-
-testVarModSuite = TestList
-    [ testVarMod01, testVarMod02, testVarMod03, testVarMod04
-    , testVarMod05, testVarMod06, testVarMod07
-    ]
-
-------------------------------------------------------------
---  Test finding built-in datatypes
-------------------------------------------------------------
-
-testDatatype01 = testJust "testDatatype01" $ findRDFDatatype typeNameXsdInteger
-
-testDatatypeSuite = TestList
-    [ testDatatype01
-    ]
-
-------------------------------------------------------------
---  Test finding built-in rulesets
-------------------------------------------------------------
-
-testRuleset01 = testJust "testRuleset01" $
-    mapFindMaybe scopeRDF rdfRulesetMap
-
-testRulesetSuite = TestList
-    [ testRuleset01
-    ]
-
-------------------------------------------------------------
---  Test finding arbitrary axioms and rules
-------------------------------------------------------------
-
-testFindAxiom01 = testJust "testFindAxiom01" $
-    getMaybeContextAxiom (ScopedName scopeRDF "a1") allRulesets
-testFindAxiom02 = testJust "testFindAxiom02" $
-    getMaybeContextAxiom (ScopedName scopeRDFS "a01") allRulesets
-testFindAxiom03 = testJust "testFindAxiom03" $
-    getMaybeContextAxiom (ScopedName (namespaceXsdType "integer") "dt")
-        allRulesets
-
-testFindAxiomSuite = TestList
-    [ testFindAxiom01, testFindAxiom02, testFindAxiom03
-    ]
-
-testFindRule01 = testJust "testFindRule01" $
-    getMaybeContextRule (ScopedName scopeRDF "r1") allRulesets
-testFindRule02 = testJust "testFindRule02" $
-    getMaybeContextRule (ScopedName scopeRDFS "r1") allRulesets
-testFindRule03 = testJust "testFindRule03" $
-    getMaybeContextRule (ScopedName scopeRDFD "r1") allRulesets
-testFindRule04 = testJust "testFindRule04" $
-    getMaybeContextRule (ScopedName (namespaceXsdType "integer") "Abs")
-        allRulesets
-
-testFindRuleSuite = TestList
-    [ testFindRule01, testFindRule02, testFindRule03, testFindRule04
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-    [ testVarModSuite
-    , testDatatypeSuite
-    , testRulesetSuite
-    , testFindAxiomSuite
-    , testFindRuleSuite
-    ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/BuiltInMapTest.hs,v $
--- $Author: graham $
--- $Revision: 1.5 $
--- $Log: BuiltInMapTest.hs,v $
--- Revision 1.5  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.4  2003/12/18 18:27:46  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.3  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.2  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.1  2003/12/08 23:56:07  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
− Swish/HaskellRDF/BuiltInRules.hs 
@@ -1,175 +0,0 @@---------------------------------------------------------------------------------
---  $Id: BuiltInRules.hs,v 1.2 2003/12/18 18:27:46 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  BuiltInRules
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module collects references and provides access to all of the
---  rulesets, variable binding modifiers and variable binding filters
---  built in to Swish.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.BuiltInRules
-    ( findRDFOpenVarBindingModifier
-    , rdfRulesetMap
-    , allRulesets, allDatatypeRulesets
-    )
-where
-
-import Swish.HaskellRDF.BuiltInDatatypes
-    ( allDatatypes )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFOpenVarBindingModify
-    , rdfVarBindingUriRef, rdfVarBindingBlank
-    , rdfVarBindingLiteral
-    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
-    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
-    , rdfVarBindingMemberProp
-    )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFRuleset, RDFRulesetMap )
-
-import Swish.HaskellRDF.RDFProofContext
-    ( rulesetRDF
-    , rulesetRDFS
-    , rulesetRDFD )
-
-import Swish.HaskellRDF.VarBinding
-    ( nullVarBindingModify
-    , makeVarFilterModify
-    , varFilterEQ, varFilterNE
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( typeRules
-    , typeMkModifiers
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..)
-    , mapFindMaybe
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-------------------------------------------------------------
---  Declare variable binding filters list
-------------------------------------------------------------
-
--- |List of rdfOpenVarBindingModify values for predefined filters
---
-rdfVarBindingFilters :: [RDFOpenVarBindingModify]
-rdfVarBindingFilters =
-    [ filter1 rdfVarBindingUriRef
-    , filter1 rdfVarBindingBlank
-    , filter1 rdfVarBindingLiteral
-    , filter1 rdfVarBindingUntypedLiteral
-    , filter1 rdfVarBindingTypedLiteral
-    , filter1 rdfVarBindingXMLLiteral
-    , filter1 rdfVarBindingMemberProp
-    , filter2 rdfVarBindingDatatyped
-    -- , filterN nullVarBindingModify
-    , filter2 varFilterEQ
-    , filter2 varFilterNE
-    ]
-    where
-        filter1 f lbs = makeVarFilterModify $ f (lbs!!0)
-        filter2 f lbs = makeVarFilterModify $ f (lbs!!0) (lbs!!1)
-        -- filterN f lbs = makeVarFilterModify $ f ...
-
-------------------------------------------------------------
---  Declare variable binding modifiers map
-------------------------------------------------------------
-
-rdfVarBindingModifiers :: [RDFOpenVarBindingModify]
-rdfVarBindingModifiers =
-    [ nullVarBindingModify
-    ]
-
-------------------------------------------------------------
---  Find a named built-in OpenVarBindingModifier
-------------------------------------------------------------
-
-allOpenVarBindingModify :: [RDFOpenVarBindingModify]
-allOpenVarBindingModify =
-    rdfVarBindingFilters    ++
-    rdfVarBindingModifiers  ++
-    dtsVarBindingModifiers
-
--- dtsVarBindingModifiers = concatMap dtVarBindingModifiers allDatatypes
-dtsVarBindingModifiers = concatMap typeMkModifiers allDatatypes
-
-{-
-dtVarBindingModifiers dtval =
-    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)
--}
-
-findRDFOpenVarBindingModifier :: ScopedName -> Maybe RDFOpenVarBindingModify
-findRDFOpenVarBindingModifier nam =
-    mapFindMaybe nam (LookupMap allOpenVarBindingModify)
-
-------------------------------------------------------------
---  Lookup map for built-in rulesets
-------------------------------------------------------------
-
-rdfRulesetMap :: RDFRulesetMap
-rdfRulesetMap = LookupMap allRulesets
-
-allRulesets :: [RDFRuleset]
-allRulesets =
-    [ rulesetRDF
-    , rulesetRDFS
-    , rulesetRDFD
-    ]
-    ++ allDatatypeRulesets
-
-allDatatypeRulesets :: [RDFRuleset]
-allDatatypeRulesets = map typeRules allDatatypes
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/BuiltInRules.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: BuiltInRules.hs,v $
--- Revision 1.2  2003/12/18 18:27:46  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.1  2003/12/17 16:56:39  graham
--- Split content of BuiltInMap into separate modules, to avoid recursive
--- module dependency with RDFProofContext.
---
− Swish/HaskellRDF/ClassRestrictionRule.hs 
@@ -1,666 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}---------------------------------------------------------------------------------
---  $Id: ClassRestrictionRule.hs,v 1.15 2004/01/07 19:49:12 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ClassRestrictionRule
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module implements an inference rule based on a restruction on class
---  membership of one or more values.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.ClassRestrictionRule
-    ( ClassRestriction(..), ClassRestrictionFn
-    , makeDatatypeRestriction, makeDatatypeRestrictionFn
-    , makeRDFClassRestrictionRules
-    , makeRDFDatatypeRestrictionRules
-    , falseGraph, falseGraphStr
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , getScopedName
-    , RDFGraph
-    , getArcs
-    , merge
-    , toRDFGraph, emptyRDFGraph
-    , Arc(..)
-    , res_rdf_type
-    , res_rdfd_maxCardinality
-    )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFRule
-    , makeRDFGraphFromN3String
-    )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatypeVal
-    , fromRDFLabel, toRDFLabel
-    )
-
-import Swish.HaskellRDF.RDFQuery
-    ( rdfQueryFind
-    , rdfFindValSubj, rdfFindPredVal, rdfFindPredInt
-    , rdfFindList
-    )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding )
-
-import Swish.HaskellRDF.Datatype
-    ( DatatypeVal(..)
-    , DatatypeRel(..), DatatypeRelFn
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Rule(..)
-    , bwdCheckInference
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDFD
-    )
-
-import Swish.HaskellUtils.PartOrderedCollection
-    ( minima, maxima
-    , partCompareEq, partComparePair
-    , partCompareListMaybe
-    , partCompareListSubset
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , mapFindMaybe
-    )
-
-import Swish.HaskellUtils.ListHelpers
-    ( powerSet )
-
-import Data.Maybe
-    ( Maybe(..)
-    , isJust, fromJust, fromMaybe, catMaybes )
-
-import Data.List
-    ( delete, nub, (\\) )
-
-import Control.Monad
-    ( liftM )
-
-import Swish.HaskellUtils.TraceHelpers
-    ( trace )
-
-------------------------------------------------------------
---  Class restriction data type
-------------------------------------------------------------
-
--- |Type of function that evaluates missing node values in a
---  restriction from those supplied.
-type ClassRestrictionFn = [Maybe RDFLabel] -> Maybe [[RDFLabel]]
-
--- |Datatype for named class restriction
-data ClassRestriction = ClassRestriction
-    { crName    :: ScopedName
-    , crFunc    :: ClassRestrictionFn
-    }
-
-instance Eq ClassRestriction where
-    cr1 == cr2  =  crName cr1 == crName cr2
-
-instance Show ClassRestriction where
-    show cr = "ClassRestriction:"++(show $ crName cr)
-
-instance LookupEntryClass ClassRestriction ScopedName ClassRestriction
-    where
-    newEntry (_,fn) = fn
-    keyVal cr = (crName cr, cr)
-
-------------------------------------------------------------
---  Instantiate a class restriction from a datatype relation
-------------------------------------------------------------
-
--- |Make a class restriction from a datatype relation.
---
---  This "lifts" application of the datatype relation to operate
---  on RDFLabel values, which are presumed to contain appropriately
---  datatyped values.
---
-makeDatatypeRestriction ::
-    RDFDatatypeVal vt -> DatatypeRel vt -> ClassRestriction
-makeDatatypeRestriction dtv dtrel = ClassRestriction
-    { crName = dtRelName dtrel
-    , crFunc = makeDatatypeRestrictionFn dtv (dtRelFunc dtrel)
-    }
-
--- |Make a class restriction function from a datatype relation function.
---
---  The core logic is something like (map toLabels . dtrelfn . map frLabel)
---  but the extra lifting and catMaybes are needed to get the final result
---  type in the right form.
---
---  ClassRestrictionFn = [Maybe RDFLabel] -> Maybe [[RDFLabel]]
---
-makeDatatypeRestrictionFn ::
-    RDFDatatypeVal vt -> DatatypeRelFn vt -> ClassRestrictionFn
-makeDatatypeRestrictionFn dtv dtrelfn =
-    liftM (catMaybes . map toLabels) . dtrelfn . (map frLabel)
-    where
-        frLabel Nothing  = Nothing
-        frLabel (Just l) = fromRDFLabel dtv l
-        toLabels         = sequence . map toLabel   -- Maybe [RDFLabel]
-        toLabel          = toRDFLabel dtv
-
-------------------------------------------------------------
---  Make rules from supplied class restrictions and graph
-------------------------------------------------------------
-
-ruleQuery :: RDFGraph-ruleQuery = makeRDFGraphFromN3String $
-    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
-    " ?c a rdfd:GeneralRestriction ; " ++
-    "    rdfd:onProperties ?p ; "      ++
-    "    rdfd:constraint   ?r . "
-
---  Placeholder false graph for now.
-falseGraph :: RDFGraph-falseGraph = makeRDFGraphFromN3String $
-    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
-    falseGraphStr
-
-falseGraphStr :: String-falseGraphStr = "_:a rdfd:false _:b . "
-
--- |Make a list of class restriction rules given a list of class restriction
---  values and a graph containing one or more class restriction definitions.
---
-makeRDFClassRestrictionRules :: [ClassRestriction] -> RDFGraph -> [RDFRule]
-makeRDFClassRestrictionRules crs gr =
-    catMaybes $ ( map constructRule . queryForRules ) gr
-    where
-        queryForRules = rdfQueryFind ruleQuery
-        constructRule = makeRestrictionRule1 crs gr
-
-makeRestrictionRule1 ::
-    [ClassRestriction] -> RDFGraph -> RDFVarBinding -> Maybe RDFRule
-makeRestrictionRule1 crs gr vb =
-    {-
-    trace "\nmakeRestrictionRule1:" $
-    -- seq (traceShow "\ngr:" gr)
-    seq (traceShow "\nvb:" vb) $
-    seq (traceShow "\nc:" c) $
-    seq (traceShow "\np:" p) $
-    seq (traceShow "\nr:" r) $
-    seq (traceShow "\nps:" ps) $
-    -- seq (traceShow "\nrn:" rn) $
-    -}
-    makeRestrictionRule2 rn c ps cs
-    where
-        c  = fromMaybe NoNode $ vbMap vb (Var "c")
-        p  = fromMaybe NoNode $ vbMap vb (Var "p")
-        r  = fromMaybe NoNode $ vbMap vb (Var "r")
-        cs = filter (>0) $ map fromInteger $
-             rdfFindPredInt c res_rdfd_maxCardinality gr
-        ps = rdfFindList gr p
-        rn = mapFindMaybe (getScopedName r) (LookupMap crs)
-
-makeRestrictionRule2 ::
-    Maybe ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int]
-    -> Maybe RDFRule
-makeRestrictionRule2 (Just restriction) cls@(Res cname) props cs =
-    {-
-    trace "\nmakeRestrictionRule2:" $
-    seq (traceShow "\ncls:" cls)
-    seq (traceShow "\nprops:" props) $
-    -}
-    Just restrictionRule
-    where
-        restrictionRule = Rule
-            { ruleName = cname
-              -- fwdApply :: [ex] -> [ex]
-            , fwdApply = fwdApplyRestriction restriction cls props cs
-              -- bwdApply :: ex -> [[ex]]
-            , bwdApply = bwdApplyRestriction restriction cls props cs
-            , checkInference = bwdCheckInference restrictionRule
-            }
-makeRestrictionRule2 _ _ _ _ =
-    trace "\nmakeRestrictionRule: missing class restriction" $
-    Nothing
-
---  Forward apply class restriction.
-fwdApplyRestriction ::
-    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> [RDFGraph]
-    -> [RDFGraph]
-fwdApplyRestriction restriction cls props cs antgrs =
-    if isJust newgrs then concat $ fromJust newgrs else [falseGraph]
-    where
-        -- Instances of the named class in the graph:
-        ris = nub $ rdfFindValSubj res_rdf_type cls antgr
-        --  Merge antecedent graphs into one (with bnode renaming):
-        --  (Uses 'if' and 'foldl1' to avoid merging in the common case
-        --  of just one graph supplied.)
-        antgr = if null antgrs then emptyRDFGraph else foldl1 merge antgrs
-        --  Apply class restriction to single instance of the restricted class
-        newgr :: RDFLabel -> Maybe [RDFGraph]
-        newgr ri = fwdApplyRestriction1 restriction ri props cs antgr
-        newgrs :: Maybe [[RDFGraph]]
-        newgrs = sequence $ map newgr ris
-
---  Forward apply class restriction to single class instance (ci).
---  Return single set of inferred results, for each combination of
---  property values, or an empty list, or Nothing if the supplied values
---  are inconsistent with the restriction.
-fwdApplyRestriction1 ::
-    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
-    -> Maybe [RDFGraph]
-fwdApplyRestriction1 restriction ci props cs antgr =
-    {-
-    trace "\nfwdApplyRestriction1:" $
-    seq (traceShow "\nci:" ci)
-    seq (traceShow "\nprops:" props)
-    seq (traceShow "\nantgr:" antgr) $
-    -}
-    if grConsistent then Just newgrs else Nothing
-    where
-        --  Apply restriction to graph
-        (grConsistent,_,_,sts) = applyRestriction restriction ci props cs antgr
-        --  Select results, eliminate those with unknowns
-        nts :: [[RDFLabel]]
-        nts = catMaybes $ map sequence sts
-        --  Make new graph from results, including only newly generated arcs
-        newarcs = nub [Arc ci p v | vs <- nts, (p,v) <- zip props vs ]
-                  \\ getArcs antgr
-        newgrs  = if null newarcs then [] else [toRDFGraph newarcs]
-
---  Backward apply class restriction.
---
---  Returns a list of alternatives, any one of which is sufficient to
---  satisfy the given consequent.
---
-bwdApplyRestriction ::
-    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
-    -> [[RDFGraph]]
-bwdApplyRestriction restriction cls props cs congr =
-    if isJust newgrs then fromJust newgrs else [[falseGraph]]
-    where
-        -- Instances of the named class in the graph:
-        ris = rdfFindValSubj res_rdf_type cls congr
-        --  Apply class restriction to single instance of the restricted class
-        newgr :: RDFLabel -> Maybe [[RDFGraph]]
-        newgr ri = bwdApplyRestriction1 restriction cls ri props cs congr
-        --  'map newgr ris' is conjunction of disjunctions, where
-        --  each disjunction is itself a conjunction of conjunctions.
-        --  'sequence' distributes the conjunction over the disjunction,
-        --  yielding an equivalent disjunction of conjunctions
-        --  map concat flattens the conjunctions of conjuctions
-        newgrs :: Maybe [[RDFGraph]]
-        newgrs = liftM (map concat . sequence) $ sequence $ map newgr ris
-
---  Backward apply a class restriction to single class instance (ci).
---  Return one or more sets of antecedent results from which the consequence
---  can be derived in the defined relation, an empty list if the supplied
---  consequence cannot be inferred, or Nothing if the consequence is
---  inconsistent with the restriction.
-bwdApplyRestriction1 ::
-    ClassRestriction -> RDFLabel -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
-    -> Maybe [[RDFGraph]]
-bwdApplyRestriction1 restriction cls ci props cs congr =
-    if grConsistent then Just grss else Nothing
-    {-
-    trace "\nfwdApplyRestriction1:" $
-    seq (traceShow "\nci:" ci)
-    seq (traceShow "\nprops:" props)
-    seq (traceShow "\ncongr:" congr) $
-    -}
-    where
-        --  Apply restriction to graph
-        (grConsistent,pvs,cts,_) =
-            applyRestriction restriction ci props cs congr
-        --  Build list of all full tuples consistent with the values supplied
-        fts :: [[RDFLabel]]
-        fts = concatMap snd cts
-        --  Construct partial tuples from members of fts from which at least
-        --  one of the supplied values can be derived
-        pts :: [([Maybe RDFLabel],[RDFLabel])]
-        pts = concatMap (deriveTuple restriction) fts
-        --  Select combinations of members of pts from which all the
-        --  supplied values can be derived
-        dtss :: [[[Maybe RDFLabel]]]
-        dtss = coverSets pvs pts
-        --  Filter members of dtss that fully cover the values
-        --  obtained from the consequence graph.
-        ftss :: [[[Maybe RDFLabel]]]
-        ftss = filter (not . (\t -> coversVals deleteMaybe t pvs)) dtss
-        --  Make new graphs for all alternatives
-        grss :: [[RDFGraph]]
-        grss = map ( makeGraphs . newArcs ) ftss
-        --  Collect arcs for one alternative
-        newArcs dts =
-            [ Arc ci p v | mvs <- dts, (p,Just v) <- zip props mvs ]
-        --  Make graphs for one alternative
-        makeGraphs = map (toRDFGraph . (:[])) . ((Arc ci res_rdf_type cls):)
-
---  Helper function to select sub-tuples from which some of a set of
---  values can be derived using a class restriction.
---
---  restriction is the restriction being evaluated.
---  ft          is a full tuple of values known to be consistent with
---              the restriction
---
---  The result returned is a list of pairs, whose first member is a partial
---  tuples from which the full tuple supplied can be derived, and the second
---  is the supplied tuple calculated from that input.
---
-deriveTuple ::
-    ClassRestriction -> [RDFLabel]
-    -> [([Maybe RDFLabel],[RDFLabel])]
-deriveTuple restriction ft =
-    map (tosnd ft) $ minima partCompareListMaybe $ filter derives partials
-    where
-        partials = sequence $ map (\x -> [Nothing,Just x]) ft
-        derives  = ([ft]==) . fromJust . crFunc restriction
-        tosnd    = flip (,)
-
---  Helper function to apply a restriction to selected information from
---  a supplied graph, and returns a tuple containing:
---  (a) an indication of whether the graph is consistent with the
---      restriction
---  (b) a list of values specified in the graph for each property
---  (c) a complete list of tuples that use combinations of values from
---      the graph and are consistent with the restriction.
---      Each member is a pair consisting of some combination of input
---      values, and a list of complete tuple values that can be
---      calculated from those inputs, or an empty list if there is
---      insufficient information.
---  (d) a set of tuples that are consistent with the restriction and use
---      as much information from the graph as possible.  This set is
---      minimal in the sense that they must all correspond to different
---      complete input tuples satisfying the restriction.
---
---  This function factors out logic that is common to forward and
---  backward chaining of a class restriction.
---
---  restriction is the class restriction being applied
---  ci          is the identifier of a graph node to be tested
---  props       is a list of properties of the graph noode whose values
---              are constrained by the class restriction.
---  cs          is a list of max cardinality constraints on the restriction,
---              the minimum of which is used as the cardinality constraint
---              on the restriction.  If the list is null, no cardinality
---              constraint is applied.
---  gr          is the graph from which property values are extracted.
---
-applyRestriction ::
-    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
-    -> ( Bool
-       , [[RDFLabel]]
-       , [([Maybe RDFLabel],[[RDFLabel]])]
-       , [[Maybe RDFLabel]]
-       )
-applyRestriction restriction ci props cs gr =
-    ( (coversVals deleteMaybe sts pvs) && cardinalityOK, pvs, cts, sts )
-    where
-        --  Extract from the antecedent graph all specified values of the
-        --  restricted properties (constructs inner list for each property)
-        pvs :: [[RDFLabel]]
-        pvs = [ rdfFindPredVal ci p gr | p <- props ]
-        --  Convert tuple of alternatives to list of alternative tuples
-        --  (Each tuple is an inner list)
-        pts :: [[Maybe RDFLabel]]
-        pts = sequence $ map allJustAndNothing pvs
-        --  Try class restriction calculation for each tuple
-        --  For each, result may be:
-        --    Nothing  (inconsistent)
-        --    Just []  (underspecified)
-        --    Just [t] (single tuple of values derived from given values)
-        --    Just ts  (alternative tuples derived from given values)
-        rts :: [Maybe [[RDFLabel]]]
-        rts = map (crFunc restriction) pts
-        --  Extract list of consistent tuples of given values
-        cts :: [([Maybe RDFLabel],[[RDFLabel]])]
-        cts = map sndFromJust $ filter (isJust . snd) (zip pts rts)
-        --  Build list of consistent tuples with maximum information
-        --  based on that supplied and available
-        -- mts = concatMap mostValues cts
-        mts = map mostOneValue cts
-        --  Eliminate consistent results subsumed by others.
-        --  This results in a mimimal possible set of consistent inputs,
-        --  because if any pair could be consistently unified then their
-        --  common subsumer would still be in the list, and both would be
-        --  thereby eliminated.
-        sts :: [[Maybe RDFLabel]]
-        sts = maxima partCompareListMaybe mts
-        --  Check the cardinality constraint
-        cardinalityOK = null cs || length sts <= minimum cs
-        --  Remove Maybe wrapper from second component of a pair
-        sndFromJust :: (a,Maybe b) -> (a,b)
-        sndFromJust (a,Just b) = (a,b)
-
---  Map a non-empty list of values to a list of Just values,
---  preceding each with a Nothing element.
---
---  Nothing corresponds to an unknown value.  This logic is used
---  as part of constructing a list of alternative tuples of known
---  data values (either supplied or calculated from the class
---  restriction).
---
-allJustAndNothing :: [a] -> [Maybe a]
-allJustAndNothing as = Nothing:map Just as
-
---  Get maximum information about possible tuple values from a
---  given pair of input tuple, which is known to be consistent with
---  the restriction, and calculated result tuples.  Where the result
---  tuple is not exactly calculated, return the input tuple.
---
---  imvs    tuple of Maybe element values, with Nothing for
---          unspecified values
---  movss   Maybe list of possible fully-specified result tuples,
---          an empty list if no result tuples can be computed
---          based on the input tuple, or Nothing if the input
---          tuple is inconsistent.
---
-mostValues :: ([Maybe a],[[a]]) -> [[Maybe a]]
-mostValues (imvs,([])) = [imvs]
-mostValues (_,movss) = map (map Just) movss
-
---  Get maximum information about possible tuple values from a
---  given pair of input and possible result tuples, which is
---  known to be consistent with the restriction.  If the result
---  tuple is not exactly calculated, return the input tuple.
---
---  This is a variant of mostValues that returns a single vector.
---  Multiple possible values are considered to be equivalent to
---  Just [], i.e. unknown result.
---
---  imvs    tuple of Maybe element values, with Nothing for
---          unspecified values
---  movss   Maybe list of possible fully-specified result tuples,
---          or an empty list if no result tuples can be computed
---          based on the input tuple.
---
-mostOneValue :: ([Maybe a],[[a]]) -> [Maybe a]
-mostOneValue (_,[movs]) = map Just movs
-mostOneValue (imvs,_)   = imvs
-
---  Helper function that returns subsets of dts that "cover" the indicated
---  values;  i.e. from which all of the supplied values can be deduced
---  by the enumerated function results.  The minima of all such subsets is
---  returned, as each of these corresponds to some minimum information needed
---  to deduce all of the given values.
---
---  pvs     is a list of lists of values to be covered.  The inner list
---          contains multiple values for each member of a tuple.
---  dts     is an enumerated list of function values from some subset of
---          the tuple space to complete tuples.  Each member is a pair
---          containing the partial tuple (using Nothing for unspecified
---          values) and the full tuple calculated from it.
---
---  The return value is a disjunction of conjunctions of partial tuples
---  that cover the indicated parameter values.
---
---  NOTE:
---  The result minimization is not perfect (cf. test2 below), but I believe
---  it is adequate for the practical situations I envisage, and in any
---  case will not result in incorrect values.  It's significance is for
---  search-tree pruning.  A perfect minimization might be achieved by
---  using a more subtle partial ordering that takes account of both subsets
---  and the partial ordering of set members in place of 'partCompareListSubset'.
---
-coverSets  :: (Eq a) => [[a]] -> [([Maybe a],[a])] -> [[[Maybe a]]]
-coverSets pvs dts =
-    minima partCompareListSubset $ map (map fst) ctss
-    where
-        ctss = filter (coverspvs) $ powerSet cts
-        cts  = minima (partComparePair partCompareListMaybe partCompareEq) dts
-        coverspvs cts = coversVals delete (map snd cts) pvs
-
---  Does a supplied list of tuples cover a list of possible alternative
---  values for each tuple member?
---
-coversVals :: (a->[b]->[b]) -> [[a]] -> [[b]] -> Bool
-coversVals dropVal ts vss =
-    -- all null (foldr dropUsed vss ts)
-    any (all null) (scanr dropUsed vss ts)
-    where
-        --  Remove single tuple values from the list of supplied values:
-        dropUsed []       []     = []
-        dropUsed (t:ts) (vs:vss) = dropVal t vs:dropUsed ts vss
-        dropUsed _ _ = error "coversVals.dropUsed: list length mismatch"
-
-{-
---  Does a supplied list of possible alternative values for each
---  element of a tuple cover every tuple in a supplied list?
---
---  (See module spike-coverVals.hs for test cases)
---
-coversAll :: ([a]->b->Bool) -> [[a]] -> [[b]] -> Bool
-coversAll matchElem vss ts = all (invss vss) ts
-    where
-        --  Test if a given tuple is covered by vss
-        invss vss t = and $ zipWith matchElem vss t
-
---  Test if the value in a Maybe is contained in a list.
-maybeElem :: (Eq a) => Maybe a -> [a] -> Bool
-maybeElem Nothing  = const True
-maybeElem (Just t) = elem t
--}
-
--- |Delete a Maybe value from a list
-deleteMaybe :: (Eq a) => Maybe a -> [a] -> [a]
-deleteMaybe Nothing  as = as
-deleteMaybe (Just a) as = delete a as
-
-------------------------------------------------------------
---  Make restriction rules from supplied datatype and graph
-------------------------------------------------------------
-
-makeRDFDatatypeRestrictionRules :: RDFDatatypeVal vt -> RDFGraph -> [RDFRule]
-makeRDFDatatypeRestrictionRules dtval gr =
-    makeRDFClassRestrictionRules dcrs gr
-    where
-        dcrs = map (makeDatatypeRestriction dtval) (tvalRel dtval)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/ClassRestrictionRule.hs,v $
--- $Author: graham $
--- $Revision: 1.15 $
--- $Log: ClassRestrictionRule.hs,v $
--- Revision 1.15  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.14  2003/12/20 12:53:39  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.13  2003/12/20 12:00:14  graham
--- Introduced new TraceHelpers module for Hugs-2003 compatibility.
---
--- Revision 1.12  2003/12/19 21:01:25  graham
--- Change Debug.Trace import (from Hugs.Trace)
---
--- Revision 1.11  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.10  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.9  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.8  2003/11/27 11:35:49  graham
--- Variable modifier tests all run.
--- Initial class constraint reasoning tests pass.
--- Fixed bug in class constraint backward-chained reasoning that returned
--- multiple instances of some statements, and did not filter out all occurrences
--- of the original statements.
---
--- Revision 1.7  2003/11/24 22:13:09  graham
--- Working on reworking datatype variable modifiers to work with
--- revised datatype framework.
---
--- Revision 1.6  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.5  2003/11/20 17:58:09  graham
--- Class-constraint backward chaining: all test cases passed.
---
--- Revision 1.4  2003/11/19 22:13:03  graham
--- Some backward chaining tests passed
---
--- Revision 1.3  2003/11/17 21:53:30  graham
--- Datatype inference forward chaining updated to allow inconsistent
--- partial inputs to be detected.  All forward chaining test cases passed.
--- Need to develop backward chaining test cases.
---
--- Revision 1.2  2003/11/14 21:48:35  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.1  2003/11/13 01:15:23  graham
--- Working on ClassRestrictionRule.
--- Code almost complete, some test cases missing.
---
− Swish/HaskellRDF/Datatype.hs 
@@ -1,1082 +0,0 @@-{-# OPTIONS -XExistentialQuantification #-}-{-# OPTIONS -XMultiParamTypeClasses #-}----------------------------------------------------------------------------------
---  $Id: Datatype.hs,v 1.21 2003/12/18 18:27:46 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Datatype
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + existential types + rank 2 polymorphism
---
---  This module defines the structures used by Swish to represent and
---  manipulate datatypes.  It is designed as a basis for handling datatyped
---  RDF literals, but the functions in this module are more generic.
---
---  Testing note:  this module supports a number of specific datatypes.
---  It is intended that functionality in this module will be tested via
---  modules RDFDatatype, ClassRestrictionRule and RDFDatatypeXsdInteger.
---  See also module ClassRestrictionRuleTest for test cases.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.Datatype
-    ( Datatype(..)
-    , typeName, typeRules, typeMkRules, typeMkModifiers, typeMkCanonicalForm
-    , getTypeAxiom, getTypeRule
-    , DatatypeVal(..)
-    , getDTMod
-    , getDTRel
-    , tvalMkCanonicalForm
-    , DatatypeMap(..)
-    , DatatypeRel(..), DatatypeRelFn, DatatypeRelPr
-    , altArgs
-    , UnaryFnDescr,    UnaryFnTable,    UnaryFnApply,    unaryFnApp
-    , BinaryFnDescr,   BinaryFnTable,   BinaryFnApply,   binaryFnApp
-    , BinMaybeFnDescr, BinMaybeFnTable, BinMaybeFnApply, binMaybeFnApp
-    , ListFnDescr,     ListFnTable,     ListFnApply,     listFnApp
-    , DatatypeMod(..), ModifierFn
-    , ApplyModifier
-    , nullDatatypeMod
-    -- , applyDatatypeMod
-    , makeVmod_1_1_inv, makeVmod_1_1
-    , makeVmod_2_1_inv, makeVmod_2_1
-    , makeVmod_2_0
-    , makeVmod_2_2
-    , makeVmod_N_1
-    , DatatypeSub(..)
-    )
-where
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    , getRulesetAxiom, getRulesetRule
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Formula(..)
-    , Rule(..)
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , addVarBinding-    , VarBindingModify(..), OpenVarBindingModify, nullVarBindingModify
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , mapFindMaybe-    )
-
-import Swish.HaskellUtils.ListHelpers
-    ( flist
-    , deleteIndex
-    )
-
-import Data.Maybe( isJust, catMaybes )
-
-import Control.Monad( join, liftM )
-
-------------------------------------------------------------
---  Datatype framework
-------------------------------------------------------------
-
--- |Datatype wraps a DatatypeVal value, hiding the value type that
---  is used only in implementations of the datatype.
---  Users see just the datatype name and associated ruleset.
---
---  Note, the 'forall' is used in the sense of existentially quantified:
---  see the Glasgow Haskell Compiler (GHC) user guide, section 7.3.12
---
-data Datatype ex lb vn = forall vt . Datatype (DatatypeVal ex vt lb vn)
-
-instance LookupEntryClass
-        (Datatype ex lb vn) ScopedName (Datatype ex lb vn)
-    where
-    newEntry (_,dt) = dt
-    keyVal dt       = (typeName dt, dt)
-
--- |Get type name from Datatype value
-typeName :: Datatype ex lb vn -> ScopedName
-typeName (Datatype dtv) = tvalName  dtv
-
--- |Get static rules from Datatype value
-typeRules :: Datatype ex lb vn -> Ruleset ex
-typeRules (Datatype dtv) = tvalRules dtv
-
--- |Make rules for Datatype value based on supplied expression
-typeMkRules :: Datatype ex lb vn -> ex -> [Rule ex]
-typeMkRules (Datatype dtv) = tvalMkRules dtv
-
--- |Make variable binding modifiers based on values supplied
-typeMkModifiers :: Datatype ex lb vn -> [OpenVarBindingModify lb vn]
-typeMkModifiers (Datatype dtv) = tvalMkMods dtv
-
--- |Get named axiom from Datatype value
-getTypeAxiom :: ScopedName -> Datatype ex lb vn -> Maybe (Formula ex)
-getTypeAxiom nam dt = getRulesetAxiom nam (typeRules dt)
-
--- |Get named rule from Datatype value
-getTypeRule :: ScopedName -> Datatype ex lb vn -> Maybe (Rule ex)
-getTypeRule  nam dt = getRulesetRule  nam (typeRules dt)
-
--- |Get cacnonical form of datatype value
-typeMkCanonicalForm :: Datatype ex lb vn -> String -> Maybe String
-typeMkCanonicalForm (Datatype dtv) valstr = tvalMkCanonicalForm dtv valstr
-
-------------------------------------------------------------
---  DatatypeVal
-------------------------------------------------------------
-
--- |DatatypeVal is a structure that defines a number of functions
---  and values that characterize the behaviour of a datatype.
---
---  A datatype is specified with respect to (polymophic in) a given
---  type of (syntactic) expression with which it may be used, and
---  a value type (whos existence is hidden as an existential type
---  within DatatypeMap
---
---  (I tried hiding the value type with an internal existential
---  declaration, but that wouldn't wash.  Hence this two-part
---  structure with Datatype (above) in which the internal detail
---  of the value type is hidden from users of the Datatype class.)
---
---  The datatype characteristic functions have two goals:
---  - to support the general datatype entailment rules defined by
---    the RDF semantics specification, and
---  - to define additional datatype-specific inference patterns by
---    means of which provide additional base functionality to
---    applications based on RDF inference.
---
---  Datatype-specific inferences are provided using the DatatypeRel
---  structure for a datatype, which allows a number of named relations
---  to be defined on datatype values, and provides mechanisms to
---  calculate missing values in a partially-specified member of
---  a relation.
---
---  Note that rules and variable binding modifiers that deal with
---  combined values of more than one datatype may be defined
---  separately.  Definitions in this module are generally applicable
---  only when using a single datatype.
---
---  An alternative model for datatype value calculations is inspired
---  by that introduced by CWM for arithmetic operations, e.g.
---       (1 2 3) math:sum ?x => ?x rdf:value 6
---  (where the bare integer n here is shorthand for "n"^^xsd:integer)
---
---  Datatype-specific inference patterns are provided in two ways:
---  (a) by variable binding modifiers that can be combined with the
---      query results during forward- for backward-chaining of
---      inference rules, and
---  (b) by the definition of inference rulesets that involve
---      datatype values.
---  I believe the first method to be more flexible than the second,
---  in that it more readily supports forward and backward chaining,
---  but can be used only through the definition of new rules.
---
---  Type parameters:
---  ex      is the type of expression with which the datatype may be used.
---  vt      is the internal value type with which the labels are associated.
---  lb      is the type of label that may be used as a variable in an
---          expression or rule.
---  vn      is the type of node that may be used to carry a value in an
---          expression or rule.
---
-data DatatypeVal ex vt lb vn = DatatypeVal
-    { tvalName      :: ScopedName
-                                -- ^Identifies the datatype, and also
-                                --  its value space class.
-    , tvalRules     :: Ruleset ex
-                                -- ^A set of named expressions and rules
-                                --  that are valid in in any theory that
-                                --  recognizes the current datatype.
-    , tvalMkRules   :: ex -> [Rule ex]
-                                -- ^A function that accepts an expression
-                                --  and devives some datatype-dependent
-                                --  rules from it.  This is provided as a
-                                --  hook for creating datatyped class
-                                --  restriction rules.
-    , tvalMkMods    :: [OpenVarBindingModify lb vn]
-                                -- ^Constructs a list of open variable
-                                --  binding modifiers based on tvalMod,
-                                --  but hiding the actual value type.
-    , tvalMap       :: DatatypeMap vt
-                                -- ^Lexical to value mapping, where 'vt' is
-                                --  a datatype used within a Haskell program
-                                --  to represent and manipulate values in
-                                --  the datatype's value space
-    , tvalRel       :: [DatatypeRel vt]
-                                -- ^A set of named relations on datatype
-                                --  values.  Each relation accepts a list
-                                --  of (Maybe vt), and computes any
-                                --  unspecified values that are in the
-                                --  relation with values supplied.
-    , tvalMod       :: [DatatypeMod vt lb vn]
-                                -- ^A list of named values that are used to
-                                --  construct variable binding modifiers, which
-                                --  in turn may be used by a rule definition.
-                                --  [[[TODO: In due course, this value may be
-                                --  calculated automatically from the supplied
-                                --  value for tvalRel.]]]
-    }
-
---  Other accessor functions
-
-getDTRel ::
-    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeRel vt)
-getDTRel nam dtv =
-    mapFindMaybe nam (LookupMap (tvalRel dtv))
-
-getDTMod ::
-    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeMod vt lb vn)
-getDTMod nam dtv =
-    mapFindMaybe nam (LookupMap (tvalMod dtv))
-
--- |Get canonical form of datatype value, or None
---
-tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> String -> Maybe String
-tvalMkCanonicalForm dtv str = can
-    where
-        val  = mapL2V (tvalMap dtv) str
-        can = join $ liftM (mapV2L (tvalMap dtv)) val
-
--- |DatatypeMap consists of methods that perform lexical-to-value
---  and value-to-canonical-lexical mappings for a datatype.
---
---  The datatype mappings apply to string lexical forms.
---
-data DatatypeMap vt = DatatypeMap
-    { mapL2V  :: String -> Maybe vt
-                            -- ^ Function to map lexical string to
-                            --   datatype value.  This effectively
-                            --   defines the lexical space of the
-                            --   datatype to be all strings for which
-                            --   yield a value other than Nothing.
-    , mapV2L  :: vt -> Maybe String
-                            -- ^ Function to map a value to its canonical
-                            --   lexical form, if it has such.
-    }
-
--- |Type for a datatype relation inference function.
---
---  A datatype relation defines tuples of values that satisfy some
---  relation.  A datatype relation inference function calculates
---  values that complete a relation with values supplied.
---
---  The function accepts a list of Maybe vt, where vt is the
---  datatype value type.  It returns:
---  (a) Just a list of lists, where each inner list returned is a
---      complete set of values, including the values supplied, that
---      are in the relation.
---  (b) Just an empty list is returned if the supplied values are
---      insufficient to compute any complete sets of values in the
---      relation.
---  (c) Nothing if the supplied values are not consistent with
---      the relation.
---
-type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
-
--- |Type for datatype relation predicate:  accepts a list of values
---  and determines whether or not they satisfy the relation.
---
-type DatatypeRelPr vt = [vt] -> Bool
-
--- |Datatype for a named relation on values of a datatype.
---
-data DatatypeRel vt = DatatypeRel
-    { dtRelName :: ScopedName
-    , dtRelFunc :: DatatypeRelFn vt
-    }
-
-instance LookupEntryClass (DatatypeRel vt) ScopedName (DatatypeRel vt)
-    where
-    newEntry (_,relf) = relf
-    keyVal dtrel = (dtRelName dtrel, dtrel)
-
--- |Datatype value modifier functions type
---
---  Each function accepts a list of values and returns a list of values.
---  The exact significance of the different values supplied and returned
---  depends on the variable binding pattern used (cf. ApplyModifier),
---  but in all cases an empty list returned means that the corresponding
---  inputs are not consistent with the function and cannot be used.
---
-type ModifierFn vn = [vn] -> [vn]
-
--- |Type of function used to apply a data value modifier to specified
---  variables in a supplied variable binding.  It also accepts the
---  name of the datatype modifier and carries it into the resulting
---  variable binding modifier.
---
---  (Note that vn is not necessarily the same as vt, the datatype value
---  type:  the modifier functions may be "lifted" or otherwise adapted
---  to operate on some other type from which the raw data values are
---  extracted.)
---
-type ApplyModifier lb vn =
-    ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
-
--- |Wrapper for data type variable binding modifier included in
---  a datatype value.
---
-data DatatypeMod vt lb vn = DatatypeMod
-    { dmName :: ScopedName
-    , dmModf :: [ModifierFn vt]
-    , dmAppf :: ApplyModifier lb vn
-    }
-
-instance LookupEntryClass
-        (DatatypeMod vt lb vn) ScopedName (DatatypeMod vt lb vn)
-    where
-    newEntry (_,dmod) = dmod
-    keyVal dmod = (dmName dmod, dmod)
-
--- |Null datatype value modifier
-nullDatatypeMod :: DatatypeMod vt lb vn
-nullDatatypeMod = DatatypeMod
-    { dmName = swishName "nullDatatypeMod"
-    , dmModf = []
-    , dmAppf = nullAppf
-    }
-    where
-        -- nullAppf :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
-        nullAppf nam _ lbs = (nullVarBindingModify lbs) { vbmName = nam }
-
-{-
--- |Apply datatype variable binding modifier value to list of labels and
---  a variable binding.
-applyDatatypeMod :: (Eq lb, Show lb, Eq vn, Show vn)
-    => DatatypeMod vt lb vn -> OpenVarBindingModify lb vn
-applyDatatypeMod dtmod = dmAppf dtmod (dmName dtmod) (dmModf dtmod)
--}
-
-{-
-dmName dtmod :: ScopedName
-dmModf dtmod :: [ModifierFn vt]
-             :: [[vt] -> [vt]]
-dmAppf dtmod :: ApplyModifier lb vn
-             :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
-             :: ScopedName -> [[vn] -> [vn]] -> OpenVarBindingModify lb vn
-dmAppf dtmod (dmName dtmod)
-             :: [[vn] -> [vn]] -> OpenVarBindingModify lb vn
--}
-
---------------------------------------------------------------
---  Functions for creating datatype variable binding modifiers
---------------------------------------------------------------
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a 1->1 function and inverse, such
---  as negate.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (0) is [x,y] -> [?], used as a filter (i.e. not creating any
---              new variable bindings), returning a non-empty list if x and y
---              are in the appropriate relationship.
---          (1) is [y] -> [x], used to perform the calculation in a forward
---              direction.
---          (2) is [x] -> [y], used to perform the calculation in a backward
---              direction.  This may be the same as (2) (e.g. for negation)
---              or may be different (e.g. increment).
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.  (The intent is that a variable-free
---          value can be generated as a Curried function, and instantiated
---          for particular variables as required.)
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
---  type ApplyModifer lb vn = [ModifierFn vn] -> [lb] -> VarBindingModify lb vn
---
-makeVmod_1_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_1_1_inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1],[lb2]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2)] vbind = selv     (f0 [v1,v2]) vbind
-        app2 [(Nothing),(Just v2)] vbind = addv lb1 (f1 [v2])    vbind
-        app2 [(Just v1),(Nothing)] vbind = addv lb2 (f2 [v1])    vbind
-        app2 _                     _     = []
-makeVmod_1_1_inv _ _ _ =
-    error "makeVmod_1_1_inv: requires 3 functions and 2 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases when
---  the value mapping is a non-invertable 1->1 injection, such as
---  absolute value.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (0) is [x,y] -> [?], used as a filter (i.e. not creating any
---              new variable bindings), returning a non-empty list if x and y
---              are in the appropriate relationship.
---          (1) is [x] -> [y], used to perform the calculation.
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
-makeVmod_1_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_1_1 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2)] vbind = selv (f0 [v1,v2])  vbind
-        app2 [(Nothing),(Just v2)] vbind = addv lb1 (f1 [v2]) vbind
-        app2 _                     _     = []
-makeVmod_1_1 _ _ _ =
-    error "makeVmod_1_1: requires 2 functions and 2 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a 2->1 invertable function, such as
---  addition or subtraction.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (1) is [x,y,z] -> [?], used as a filter (i.e. not creating any
---              new variable bindings), returning a non-empty list if
---              x, y and z are in the appropriate relationship.
---          (2) is [y,z] -> [x], used to perform the calculation in a
---              forward direction.
---          (3) is [x,z] -> [y], used to run the calculation backwards to
---              determine the first input argument
---          (4) is [x,y] -> [z], used to run the calculation backwards to
---              determine the second input argument
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
-makeVmod_2_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_2_1_inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1],[lb2],[lb3]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2),(Just v3)] vbind = selv (f0 [v1,v2,v3]) vbind
-        app2 [(Nothing),(Just v2),(Just v3)] vbind = addv lb1 (f1 [v2,v3]) vbind
-        app2 [(Just v1),(Nothing),(Just v3)] vbind = addv lb2 (f2 [v1,v3]) vbind
-        app2 [(Just v1),(Just v2),(Nothing)] vbind = addv lb3 (f3 [v1,v2]) vbind
-        app2 _                               _     = []
-makeVmod_2_1_inv _ _ _ =
-    error "makeVmod_2_1_inv: requires 4 functions and 3 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a 2->1 non-invertable function, such as
---  logical AND or OR.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (1) is [x,y,z] -> [?], used as a filter (i.e. not creating any
---              new variable bindings), returning a non-empty list if
---              x, y and z are in the appropriate relationship.
---          (2) is [y,z] -> [x], used to perform the calculation in a
---              forward direction.
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
-makeVmod_2_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_2_1 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2),(Just v3)] vbind = selv (f0 [v1,v2,v3]) vbind
-        app2 [(Nothing),(Just v2),(Just v3)] vbind = addv lb1 (f1 [v2,v3]) vbind
-        app2 _                               _     = []
-makeVmod_2_1 _ _ _ =
-    error "makeVmod_2_1: requires 2 functions and 3 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a simple comparson of two values.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (1) is [x,y] -> [?], used as a filter (i.e. not creating any
---              new variable bindings), returning a non-empty list if
---              x and y are in the appropriate relationship.
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
-makeVmod_2_0 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_2_0 nam [f0] lbs@(~[_,_]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2)] vbind = selv (f0 [v1,v2]) vbind
-        app2 _                     _     = []
-makeVmod_2_0 _ _ _ =
-    error "makeVmod_2_0: requires 1 function and 2 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a 2->2 non-invertable function, such as
---  quotient/remainder
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (1) is [w,x,y,z] -> [?], used as a filter (i.e. not creating
---              any new variable bindings), returning a non-empty list if
---              w, x, y and z are in the appropriate relationship.
---          (2) is [y,z] -> [w,x], used to perform the calculation given
---              two input values.
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
---  [[[NOTE: this might be generalized to allow one of w or x to be
---  specified, and return null if it doesn't match the calculated value.]]]
---
-makeVmod_2_2 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_2_2 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1,lb2]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 [(Just v1),(Just v2),(Just v3),(Just v4)] vbind =
-            selv (f0 [v1,v2,v3,v4]) vbind
-        app2 [(Nothing),(Nothing),(Just v3),(Just v4)] vbind =
-            addv2 lb1 lb2 (f1 [v3,v4]) vbind
-        app2 _                               _     = []
-makeVmod_2_2 _ _ _ =
-    error "makeVmod_2_2: requires 2 functions and 4 labels"
-
--- |ApplyModifier function for use with DatatypeMod in cases
---  when the value mapping is a N->1 function,
---  such as Sigma (sum) of a vector.
---
---  nam     ia the name from the DatatypeMod value that is carried into
---          the resulting variable binding modifier.
---  fns     are functions used to implement details of the variable
---          binding modifier:
---          (1) is [x,y...] -> [?], used as a filter (i.e. not creating
---              any new variable bindings), returning a non-empty list if
---              x and y... are in the appropriate relationship.
---          (2) is [y...] -> [x], used to perform the calculation.
---  lbs     is a list of specific label values for which a variable binding
---          modifier will be generated.
---
---  Note: an irrefutable pattern match for 'lbs' is used so that a name
---  for the VarBindingModify value can be extracted using an undefined
---  label value.
---
-makeVmod_N_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
-makeVmod_N_1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify
-    { vbmName   = nam
-    , vbmApply  = concatMap app1
-    , vbmVocab  = lbs
-    , vbmUsage  = [[],[lb1]]
-    }
-    where
-        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
-        app2 vs@(v1:_) vbind
-            | isJust v1 && isJustvs = selv (f0 jvs) vbind
-            | isJustvs              = addv lb1 (f1 jvs) vbind
-            | otherwise             = []
-            where
-                isJustvs = all isJust vs
-                jvs      = catMaybes vs
-makeVmod_N_1 _ _ _ =
-    error "makeVmod_N_1: requires 2 functions and at 1 or more labels"
-
---------------------------------------------------------
---  Local helper functions for makeVmodXXX variants
---------------------------------------------------------
-
---  Add value to variable variable binding, if value is singleton list,
---  otherwise return empty list.
-addv :: (Eq lb, Show lb, Eq vt, Show vt)
-    => lb -> [vt] -> VarBinding lb vt
-    -> [VarBinding lb vt]
-addv lb [val] vbind = [addVarBinding lb val vbind]
-addv _  _     _     = []
-
---  Add two entries to variable variable binding, if value supplied is
---  a doubleton list, otherwise return empty list.
-addv2 :: (Eq lb, Show lb, Eq vt, Show vt)
-    => lb -> lb -> [vt] -> VarBinding lb vt
-    -> [VarBinding lb vt]
-addv2 lb1 lb2 [val1,val2] vbind = [addVarBinding lb1 val1 $
-                                   addVarBinding lb2 val2 vbind]
-addv2 _   _   _           _     = []
-
---  If supplied value is non-empty list return supplied variable binding,
---  otherwise return empty list.
-selv :: [vt] -> varBinding lb vt -> [varBinding lb vt]
-selv [] _     = []
-selv _  vbind = [vbind]
-
---------------------------------------------------------------
---  Functions for evaluating arguments in a datatype relation
---------------------------------------------------------------
---
---  altArgs is a generic function for evaluating datatype relation
---          values, based on suppied functions and argument values
---
---  UnaryFnDescr, UnaryFnApply and unaryFnApp:
---          are support types and function for using altArgs to
---          evaluate relations on unary functions (binary relations).
---
---  BinaryFnDescr, BinaryFnApply and binaryFnApp:
---          are support types and function for using altArgs to
---          evaluate relations on binary functions (3-way relations).
---
---  ListFnDescr, ListFnApply and listFnApp:
---          are support types and function for using altArgs to
---          evaluate relations on list functions (n-way relations),
---          where the first member of the list is the value of a
---          fold of a function over the rest of the list.
---
---  See experimental module spike-altargs.hs for test cases and
---  development steps for this function.
-
--- |Given a list of argument values and a list of functions for
---  calculating new values from supplied values, return a list
---  of argument values, or Nothing if the supplied values are
---  inconsistent with the calculations specified.
---
---  Each list of values returned corresponds to a set of values that
---  satisfy the relation, consistent with the values supplied.
---
---  Functions are described as tuple consisting of
---  (a) a predicate that the argument is required to satisfy
---  (b) a function to apply,
---  (c) a function to apply function (b) to a list of arguments
---  (d) argument list index values to which the function is applied.
---
---  Each supplied argument is of the form 'Maybe a', where the argument
---  has value type a.  'Nothing' indicates arguments of unknown value.
---
---  The basic idea is that, for each argument position in the relation,
---  a function may be supplied to calculate that argument's possible values
---  from some combination of the other arguments.  The results calculated
---  in this way are compared with the original arguments provided:
---  if the values conflict then the relation is presumed to be
---  unsatisfiable with the supplied values, and 'Nothing' is returned;
---  if there are any calculated values for arguments supplied without
---  any values, then tbe calculated values are used.
---  If there are any arguments for which no values are supplied or
---  calculated, then the relation is presumed to be underdetermined,
---  and 'Just []' is returned.
---
---  fnss    is a list of argument value predicates and
---          function descriptors.  The predicate indicates any
---          additional constraints on argument values (e.g. the result
---          of abs must be positive).  Use (const True) for the predicate
---          associated with unconstrained relation arguments.
---          For each argument, a list of function descriptors is
---          supplied corresponding to alternative values (e.g. a square
---          relation would offer two alternative values for the root.)
---  apfn    is a function that takes an argument value predicate,
---          a function descriptor and applies it to a supplied argument
---          list to return:
---          Just a calculated list of one or more possible argument values,
---          Just [] indicating insufficient information provided, or
---          Nothing indicating inconsistent information provided.
---          May be one of unaryFnApp, binaryFnApp, listFnApp or
---          some other caller-supplied value.
---          The value used must match the type of 'fnss' used.
---
---  Returns a 'DatatypeRelFn vt' value that can be used as the
---  'dtRelFunc' component of a DatatypeRel value.
---  cf. type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
---
--- type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
--- type DatatypeRelPr vt = [vt] -> Bool
---
-altArgs :: (Eq vt)
-    => DatatypeRelPr vt -> [(vt->Bool,[b])]
-    -> ((vt->Bool)->b->[Maybe vt]->Maybe [vt])
-    -> DatatypeRelFn vt
-altArgs pr fnss apfn args = cvals4 cvals3
-    where
-        --  Calculate new value(s) for each argument from supplied values, and
-        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.
-        --    cvals1 :: [Maybe [vt]]
-        cvals1 = flist (map (applyFdescToTuple apfn) fnss) args
-        --  Merge calculated values with supplied arguments, and again
-        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.
-        --    cvals2 :: Maybe [[vt]]
-        cvals2 = sequence $ mergeTupleVals (map fst fnss) args cvals1
-        --  Map list of alternative values for each tuple member to
-        --  a list of alternative tuples.
-        cvals3 = liftM sequence cvals2
-        --  Check each tuple against the supplied predicate.
-        --  If any of the alternative tuples does not match the predicate
-        --  then signal an inconsistency.
-        cvals4 Nothing       = Nothing
-        cvals4 cvs@(Just ts) = if all pr ts then cvs else Nothing
-
---  Perform alternative calculations for single result value
---  Each result value is a list of zero or more alternatives
---  that can be calculated from available parameters, or
---  Nothing if the available parameters are inconsistent.
---
---  apfn    is the function that actually applies an element of
---          the function descriptor to a tuple of Maybe arguments
---          (where Nothing is used to indicate an unknown value)
---  (p,fns) is a pair consisting of a value-checking predicate
---          for the corresponding tuple member, and a list of
---          function descriptors that each return one or more
---          values the tuple member, calculated from other values
---          that are present.  Just [] means no values are
---          calculated for this member, and Nothing means the
---          calculation has detected tuple values supplied that
---          are inconsistent with the datatype relation concerned.
---  args    is a tuple of Maybe tuple elements, (where Nothing
---          indicates an unknown value).
---
---  Returns Maybe a list of alternative values for the member,
---  Just [] to indicate insufficient information to calculate
---  any new values, and Nothing to indicate an inconsistency.
---
-applyFdescToTuple ::
-    ((vt->Bool)->b->[Maybe vt]->Maybe [vt]) -> (vt->Bool,[b]) -> [Maybe vt]
-    -> Maybe [vt]
-applyFdescToTuple apfn (p,fns) args =
-    liftM concat $ sequence cvals
-    where
-        -- cvals :: [Maybe [vt]]
-        cvals = flist (map (apfn p) fns) args
-
---  Merge calculated tuple values with supplied tuple, checking for consistency.
---
---  ps      predicates used for isolated validation of each tuple member
---  args    supplied tuple values, with Nothing for unknown values
---  cvals   list of alternative calculated values for each tuple member,
---          or Nothing if an inconsistency has been detected by the
---          tuple-calculation functions.  Note that this list may contain
---          more entries than args; the surplus entries are ignored
---          (see list functions for how this is used).
---
---  Returns a tuple of Maybe lists of values for each tuple member,
---  containing Nothing if an inconsistency has been detected in the
---  supplied values.
---
-mergeTupleVals  :: (Eq a) => [a->Bool] -> [Maybe a] -> [Maybe [a]] -> [Maybe [a]]
-mergeTupleVals _ _  (Nothing:_) = [Nothing]
-mergeTupleVals (_:ps) (Nothing:a1s) (Just a2s:a2ss)
-                             = Just a2s:mergeTupleVals ps a1s a2ss
-mergeTupleVals (p:ps) (Just a1:a1s) (Just []:a2ss)
-    | p a1                   = Just [a1]:mergeTupleVals ps a1s a2ss
-    | otherwise              = [Nothing]
-mergeTupleVals (p:ps) (Just a1:a1s) (Just a2s:a2ss)
-    | p a1 && elem a1 a2s    = Just [a1]:mergeTupleVals ps a1s a2ss
-    | otherwise              = [Nothing]
-mergeTupleVals _ [] _        = []
-mergeTupleVals _ _  _        = [Nothing]
-
--- |altArgs support for unary functions: function descriptor type
-type UnaryFnDescr a = (a->a,Int)
-
--- |altArgs support for unary functions: function descriptor table type
-type UnaryFnTable a = [(a->Bool,[UnaryFnDescr a])]
-
--- |altArgs support for unary functions: function applicator type
-type UnaryFnApply a = (a->Bool) -> UnaryFnDescr a -> [Maybe a] -> Maybe [a]
-
--- |altArgs support for unary functions: function applicator
-unaryFnApp :: UnaryFnApply a
-unaryFnApp p (f1,n) args = apf p f1 (args!!n)
-    where
-        apf p f1 (Just a) = if p r then Just [r] else Nothing where r = f1 a
-        apf _ _ Nothing   = Just []
-
--- |altArgs support for binary functions: function descriptor type
-type BinaryFnDescr a = (a->a->a,Int,Int)
-
--- |altArgs support for binary functions: function descriptor table type
-type BinaryFnTable a = [(a->Bool,[BinaryFnDescr a])]
-
--- |altArgs support for binary functions: function applicator type
-type BinaryFnApply a =
-    (a->Bool) -> BinaryFnDescr a -> [Maybe a] -> Maybe [a]
-
--- |altArgs support for binary functions: function applicator
-binaryFnApp :: BinaryFnApply a
-binaryFnApp p (f,n1,n2) args = apf p f (args!!n1) (args!!n2)
-    where
-        apf p f (Just a1) (Just a2) = if p r then Just [r] else Nothing
-            where r = f a1 a2
-        apf _ _ _ _  = Just []
-
--- |altArgs support for binary function with provision for indicating
---  inconsistent supplied values:  function descriptor type
-type BinMaybeFnDescr a = (a->a->Maybe [a],Int,Int)
-
--- |altArgs support for binary function with provision for indicating
---  inconsistent supplied values:  function descriptor table type
-type BinMaybeFnTable a = [(a->Bool,[BinMaybeFnDescr a])]
-
--- |altArgs support for binary function with provision for indicating
---  inconsistent supplied values:  function applicator type
-type BinMaybeFnApply a =
-    (a->Bool) -> BinMaybeFnDescr a -> [Maybe a] -> Maybe [a]
-
--- |altArgs support for binary function with provision for indicating
---  inconsistent supplied values:  function applicator
-binMaybeFnApp :: BinMaybeFnApply a
-binMaybeFnApp p (f,n1,n2) args = apf p f (args!!n1) (args!!n2)
-    where
-        apf p f (Just a1) (Just a2) = if pm r then r else Nothing
-            where
-                r = f a1 a2
-                pm Nothing  = False
-                pm (Just r) = all p r
-        apf _ _ _ _  = Just []
-
--- |altArgs support for list functions (e.g. sum over list of args),
---  where first element of list is a fold over the rest of the list,
---  and remaining elements of list can be calculated in terms
---  of the result of the fold and the remaining elements
---
---  List function descriptor is
---  (a) list-fold function, f  (e.g. (+)
---  (b) list-fold identity, z  (e.g. 0)
---  (c) list-fold-function inverse, g (e.g. (-))
---  (d) index of element to evaluate
---  such that:
---      (a `f` z) == (z `f` a) == a
---      (a `g` c) == b <=> a == b `f` c
---      (a `g` z) == a
---      (a `g` a) == z
---  and the result of the folded function does not depend on
---  the order that the list elements are processed.
---
---  NOTE:  the list of 'ListFnDescr' values supplied to altArgs must
---  be at least as long as the argument list.  In many cases, Haskell
---  lazy evaluation can be used to supply an arbitrarily long list.
---  See test cases in spike-altargs.hs for an example.
---
---  Function descriptor type
-type ListFnDescr a = (a->a->a,a,a->a->a,Int)
-
--- |Function table type
-type ListFnTable a = [(a->Bool,[ListFnDescr a])]
-
--- |altArgs support for list functions:  function applicator type
-type ListFnApply a = (a->Bool) -> ListFnDescr a -> [Maybe a] -> Maybe [a]
-
--- |altArgs support for list functions:  function applicator
-listFnApp :: ListFnApply a
-listFnApp p (f,z,g,n) (a0:args)
-    | n == 0    =
-        app p $ foldr (apf f) (Just [z]) args
-    | otherwise =
-        app p $ apf g a0 (foldr (apf f) (Just [z]) (args `deleteIndex` (n-1)))
-    where
-        apf :: (a->a->a) -> Maybe a -> Maybe [a] -> Maybe [a]
-        apf f (Just a1) (Just [a2]) = Just [f a1 a2]
-        apf _ _         _           = Just []
-        app :: (a->Bool) -> Maybe [a] -> Maybe [a]
-        app p Nothing      = Nothing
-        app p r@(Just [a]) = if p a then r else Nothing
-        app _ _            = Just []
-
---------------------------------------------------------
---  Datatype sub/supertype description
---------------------------------------------------------
-
--- |Describe a subtype/supertype relationship between a pair of datatypes.
---
---  Originally, I had this as a supertype field of the DatatypeVal structure,
---  but that suffered from some problems:
---  (a) supertypes may be introduced retrospectively,
---  (b) the relationship expressed with respect to a single datatype
---      cannot indicate hiow to do injections/restrictions between the
---      underlying value types.
---
---  ex      is the type of expression with which the datatype may be used.
---  lb      is the type of the variable labels used.
---  vn      is the type of value node used to contain a datatyped value
---  supvt   is the internal value type of the super-datatype
---  subvt   is the internal value type of the sub-datatype
---
-data DatatypeSub ex lb vn supvt subvt = DatatypeSub
-    { trelSup   :: DatatypeVal ex supvt lb vn
-                                -- ^ Datatype that is a supertype of trelSub,
-                                --   having value space supvt.
-    , trelSub   :: DatatypeVal ex subvt lb vn
-                                -- ^ Datatype that is a subtype of trelSup,
-                                --   having value space supvt.
-    , trelToSup :: subvt -> supvt
-                                -- ^ Function that maps subtype value to
-                                --   corresponding supertype value.
-    , trelToSub :: supvt -> Maybe subvt
-                                -- ^ Function that maps supertype value to
-                                --   corresponding subtype value, if there
-                                --   is such a value.
-    }
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Datatype.hs,v $
--- $Author: graham $
--- $Revision: 1.21 $
--- $Log: Datatype.hs,v $
--- Revision 1.21  2003/12/18 18:27:46  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.20  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.19  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.18  2003/12/08 17:29:19  graham
--- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
---
--- Revision 1.17  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.16  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.15  2003/11/27 11:35:49  graham
--- Variable modifier tests all run.
--- Initial class constraint reasoning tests pass.
--- Fixed bug in class constraint backward-chained reasoning that returned
--- multiple instances of some statements, and did not filter out all occurrences
--- of the original statements.
---
--- Revision 1.14  2003/11/25 23:02:17  graham
--- Reworked datatype variable modifier logic.
--- Limited range of test cases so far all pass.
---
--- Revision 1.13  2003/11/24 22:13:09  graham
--- Working on reworking datatype variable modifiers to work with
--- revised datatype framework.
---
--- Revision 1.12  2003/11/17 21:53:31  graham
--- Datatype inference forward chaining updated to allow inconsistent
--- partial inputs to be detected.  All forward chaining test cases passed.
--- Need to develop backward chaining test cases.
---
--- Revision 1.11  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.10  2003/11/11 21:02:55  graham
--- Working on datatype class-constraint inference rule.  Incomplete.
---
--- Revision 1.9  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.8  2003/11/06 17:58:33  graham
--- About to rework Datatype to better support class-based reasoning.
---
--- Revision 1.7  2003/10/24 21:05:08  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.6  2003/10/22 15:47:46  graham
--- Working on datatype inference support.
---
--- Revision 1.5  2003/10/09 13:58:59  graham
--- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
--- of using just QueryBindingModifier.
---
--- Revision 1.4  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.3  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.2  2003/09/22 23:25:01  graham
--- Add some tweaks to the datatyping framework
---
--- Revision 1.1  2003/07/03 20:31:07  graham
--- Add initial draft of datatype framework.
---
− Swish/HaskellRDF/Dfa/Dfa.lhs 
@@ -1,614 +0,0 @@-> {-# OPTIONS -fglasgow-exts #-}-> {-# LANGUAGE UndecidableInstances #-}--> module Swish.HaskellRDF.Dfa.Dfa (->     Re(..),->     matchRe,->     matchRe2-> ) where--> import Control.Monad.Identity-> import Control.Monad.Reader-> import Control.Monad.State-> import qualified Data.List as L-> import qualified Data.Map as M-> import qualified Data.Array as A-> import Data.Maybe--import IOExts---The type of a regular expression.--> data Re t->   = ReOr [Re t]->   | ReCat [Re t]->   | ReStar (Re t)->   | RePlus (Re t)->   | ReOpt (Re t)->   | ReTerm [t]->       deriving (Show)---The internal type of a regular expression.--> type SimplRe t = Int-> data SimplRe' t->   = SReOr (SimplRe t) (SimplRe t)->   | SReCat (SimplRe t) (SimplRe t)->   | SReStar (SimplRe t)->   | SReLambda->   | SReNullSet->   | SReTerm t->       deriving (Eq, Ord, Show)---The regular expression builder monad.--> data (Ord t) => ReRead t->  = ReRead {->       rerNullSet      :: SimplRe t,->       rerLambda       :: SimplRe t->  }--> data (Ord t) => ReState t->   = ReState {->       resFwdMap       :: M.Map (SimplRe t) (ReInfo t),->       resBwdMap       :: M.Map (SimplRe' t) (SimplRe t),->       resNext         :: Int,->       resQueue        :: ([SimplRe t], [SimplRe t]),->       resStatesDone   :: [SimplRe t]->     }--> type ReM m t a = StateT (ReState t) (ReaderT (ReRead t) m) a----Running the monad is tricky because the reader transformer (which-is the _inner_ transformer) requires information gained from-initialising the mutable state.  We could do some trickiness with-lazy evaluation, but it would be hard to get right.--What we do instead is run a "bootstrap" monad which does the-initialisation then returns the state.  Then we construct a new-monad using that initial state.  Simple but effective.  The only-thing to be careful about is to make sure that the bootstrap code-does not depend on the reader state.  As it happens, we only call-remInsert which only touches mutable state.---> remRun :: (ReVars m t) => ReM m t a -> m a-> remRun m->  = do (inits, initr) <- runReaderT (evalStateT bootstrap initState) initRead->       runReaderT (evalStateT m inits) initr->  where->       initState->         = ReState {->               resFwdMap = M.empty,->               resBwdMap = M.empty,->               resNext = 0,->               resQueue = ([],[]),->               resStatesDone = []->         }->       initRead->         = ReRead { rerNullSet = undefined, rerLambda = undefined }->       bootstrap->          = do->               nulli <- remInsert (reiMake SReNullSet False)->               lami  <- remInsert (reiMake SReLambda  True)->               s <- get->               r <- ask->               return (s, r { rerNullSet = nulli, rerLambda = lami })-----Utility typeclasses for enforcing all the constraints we need-on our monad's free type variables.  Note that this requires both--fglasgow-exts and -fallow-undecidable-instances in GHC to work-properly.--> class (Monad m, Ord t) => ReVars m t where { }-> instance (Monad m, Ord t) => ReVars m t where { }---Operations on the monad.--> remNullSet :: (ReVars m t) => ReM m t (SimplRe t)-> remNullSet = asks rerNullSet--> remLambda :: (ReVars m t) => ReM m t (SimplRe t)-> remLambda = asks rerLambda--> remStateDone :: (ReVars m t) => SimplRe t -> ReM m t ()-> remStateDone re->   = do s <- get->        put (s { resStatesDone = re:resStatesDone s })--> remPush :: (ReVars m t) => [SimplRe t] -> ReM m t ()-> remPush res->   = do s <- get->        let (qf,qb) = resQueue s->        put (s { resQueue = (qf, res ++ qb) })--> remPop :: (ReVars m t) => ReM m t (Maybe (SimplRe t))-> remPop->   = get >>= \s ->->       let (qf,qb) = resQueue s->       in->           case qf of->               (re:res) -> put (s { resQueue = (res,qb) }) >> return (Just re)->               []       -> if null qb then return Nothing->                           else put (s { resQueue = (reverse qb,[]) })->                                       >> remPop----> remInsert :: (ReVars m t) => ReInfo t -> ReM m t (SimplRe t)-> remInsert reinfo->   = do s <- get->        let fwd = resFwdMap s->            bwd = resBwdMap s->            newre = resNext s->        put (s { resFwdMap = M.insert newre reinfo fwd,         -- PROBLEM->                resBwdMap = M.insert (reiSRE reinfo) newre bwd,->                resNext = newre + 1 })->        return newre---> remLookupFwd :: (ReVars m t) => SimplRe t -> ReM m t (ReInfo t)-> remLookupFwd re->   = do fwd <- gets resFwdMap->        let { Just reinfo = M.lookup re fwd }                    -- PROBLEM->        return reinfo---> remLookupBwd :: (ReVars m t) => SimplRe' t->       -> ReM m t (Maybe (SimplRe t))-> remLookupBwd re->   = do bwd <- gets resBwdMap->        return (M.lookup re bwd)                                -- PROBLEM---remAdd implements hash consing.  Given a SimplRe' in as close-to "canonical" form as possible, this tries to find a SimplRe-that matches (if possible), and otherwise constructs a new one.--> remAdd :: (ReVars m t) => SimplRe' t -> ReM m t (SimplRe t)-> remAdd sre->   = remLookupBwd sre >>= \ maybere ->->       case maybere of->           Just re -> return re->           Nothing -> doInsert->   where->       doInsert->         = remNullable sre >>= \nullable ->->               remInsert (reiMake sre nullable)---> remSetDfaState :: (ReVars m t) => SimplRe t -> ReDfaState t ->->                       ReM m t (ReDfaState t)-> remSetDfaState re dfa->   = do s <- get->        let    Just reinfo = M.lookup re (resFwdMap s)              -- PROBLEM->               reinfo' = reinfo { reiDfa = Just dfa }->        put (s { resFwdMap = M.insert  re reinfo' (resFwdMap s) })    -- PROBLEM->        return dfa---The ReInfo type--> data ReInfo t->   = ReInfo {->       reiSRE          :: SimplRe' t,->       reiNullable     :: Bool,->       reiDfa          :: Maybe (ReDfaState t)->     }->       deriving (Show)--> reiMake :: SimplRe' t -> Bool -> ReInfo t-> reiMake re nullable->   = ReInfo { reiSRE = re, reiNullable = nullable, reiDfa = Nothing }---Regular expression builder.--> remNullable :: (ReVars m t) => SimplRe' t -> ReM m t Bool-> remNullable (SReOr e1 e2)->   = do ei1 <- remLookupFwd e1->        ei2 <- remLookupFwd e2->        return $ reiNullable ei1 || reiNullable ei2-> remNullable (SReCat e1 e2)->   = do ei1 <- remLookupFwd e1->        ei2 <- remLookupFwd e2->        return $ reiNullable ei1 && reiNullable ei2-> remNullable (SReStar _)->   = return True-> remNullable SReLambda->   = return True-> remNullable SReNullSet->   = return False-> remNullable (SReTerm _)->   = return False----> remBuildOne :: (ReVars m t) => SimplRe' t ->->               ReM m t (SimplRe t)--> remBuildOne re@(SReOr e1 e2)->   | e1 == e2   = return e1->   | e1 > e2    = remBuildOne (SReOr e2 e1)->   | otherwise->       = do ei1 <- remLookupFwd e1->            ei2 <- remLookupFwd e2->            remBuildOr e1 e2 (reiSRE ei1) (reiSRE ei2)->       where->           remBuildOr _  e3 (SReOr e1 e2) _->             = remBuildOne (SReOr e2 e3) >>= \ e2' ->->               remBuildOne (SReOr e1 e2')->           remBuildOr _  e2 SReNullSet _ = return e2->           remBuildOr e1 _  _ SReNullSet = return e1->           remBuildOr _  _  _ _ = remAdd re--> remBuildOne re@(SReCat e1 e2)->   = do ei1 <- remLookupFwd e1->        ei2 <- remLookupFwd e2->        remBuildCat e1 e2 (reiSRE ei1) (reiSRE ei2)->   where->       remBuildCat _  e3 (SReCat e1 e2) _->         = remBuildOne (SReCat e2 e3) >>= \ e2' ->->           remBuildOne (SReCat e1 e2')->       remBuildCat e1 _  SReNullSet _ = return e1->       remBuildCat _  e2 SReLambda  _ = return e2->       remBuildCat _  e2 _ SReNullSet = return e2->       remBuildCat e1 _  _ SReLambda  = return e1->       remBuildCat _  _  _ _ = remAdd re--> remBuildOne re@(SReStar e)->   = do ei <- remLookupFwd e->        remBuildStar e (reiSRE ei)->   where->       remBuildStar e (SReStar _) = return e->       remBuildStar e SReLambda   = return e->       remBuildStar e SReNullSet  = remLambda->       remBuildStar _ _           = remAdd re--> remBuildOne re@SReLambda = remLambda--> remBuildOne re@SReNullSet = remNullSet--> remBuildOne re@(SReTerm t) = remAdd re----> remBuild :: (ReVars m t) => Re t -> ReM m t (SimplRe t)-> remBuild (ReOr [])->   = remNullSet-> remBuild (ReOr [e])->   = remBuild e-> remBuild (ReOr (e:es))->   = do es' <- remBuild (ReOr es)->        e'  <- remBuild e->        remBuildOne (SReOr e' es')-> remBuild (ReCat [])->   = remLambda-> remBuild (ReCat [e])->   = remBuild e-> remBuild (ReCat (e:es))->   = do es' <- remBuild (ReCat es)->        e'  <- remBuild e->        remBuildOne (SReCat e' es')-> remBuild (ReOpt e)->   = do e2 <- remBuild e->        e1 <- remLambda->        remBuildOne (SReOr e1 e2)-> remBuild (ReStar e)->   = do e' <- remBuild e->        remBuildOne (SReStar e')-> remBuild (RePlus e)->   = do e1 <- remBuild e->        e2 <- remBuildOne (SReStar e1)->        remBuildOne (SReCat e1 e2)-> remBuild (ReTerm [])->   = remLambda-> remBuild (ReTerm [t])->   = remBuildOne (SReTerm t)-> remBuild (ReTerm (t:ts))->   = do ts' <- remBuild (ReTerm ts)->        t'  <- remBuildOne (SReTerm t)->        remBuildOne (SReCat t' ts')---Dfa construction--> data ReDfaState t->   = ReDfaState {->         dfaFinal :: Bool,->       dfaTrans :: [(t, SimplRe t)]->   }->       deriving (Show)--> remMakeDfa :: (ReVars m t) => SimplRe t -> ReM m t ()-> remMakeDfa start->   = do lams  <- remLambda->        nulls <- remNullSet->        remPush [lams, nulls, start]->        remMakeDfa'->   where->     remMakeDfa'->       = remPop >>= \ maybere ->->           case maybere of->               Just re -> processState re >> remStateDone re >> remMakeDfa'->               Nothing -> return ()-->     processState re->       = remLookupFwd re >>= \ info ->->           case reiDfa info of->               Just dfa -> return dfa->               Nothing  -> expandState re info (reiSRE info)-->     expandState re info (SReCat e1 e2)->       = do    dfa1 <- processState e1->               trans1 <- makeCatTrans (dfaTrans dfa1) e2->               trans <- if dfaFinal dfa1->                        then processState e2 >>= \dfa2 ->->                               makeOrTrans trans1 (dfaTrans dfa2)->                        else return trans1->               remPush (map snd trans)->               remSetDfaState re->                       (ReDfaState {->                               dfaFinal = reiNullable info,->                               dfaTrans = trans->                       })->     expandState re info (SReOr e1 e2)->       = do    dfa1 <- processState e1->               dfa2 <- processState e2->               trans <- makeOrTrans (dfaTrans dfa1) (dfaTrans dfa2)->               remPush (map snd trans)->               remSetDfaState re->                       (ReDfaState {->                               dfaFinal = reiNullable info,->                               dfaTrans = trans->                       })->     expandState re info (SReStar e)->       = do    dfa <- processState e->               let trans' = dfaTrans dfa->               trans <- makeCatTrans trans' re->               remPush (map snd trans)->               remSetDfaState re->                       (ReDfaState {->                               dfaFinal = True,->                               dfaTrans = trans->                       })->     expandState re info (SReTerm t)->       = do    e2' <- remLambda->               remPush [e2']->               remSetDfaState re->                       (ReDfaState {->                               dfaFinal = False,->                               dfaTrans = [(t,e2')]->                       })->     expandState re info SReLambda->       = remSetDfaState re (ReDfaState { dfaFinal = True, dfaTrans = [] })->     expandState re info SReNullSet->       = remSetDfaState re (ReDfaState { dfaFinal = False, dfaTrans = [] })--> makeOrTrans :: (ReVars m t) => [(t, SimplRe t)]->                       -> [(t, SimplRe t)] -> ReM m t [(t, SimplRe t)]-> makeOrTrans [] ts2->     = return ts2-> makeOrTrans ts1 []->     = return ts1-> makeOrTrans ts1'@(tr1@(t1,s1):ts1) ts2'@(tr2@(t2,s2):ts2)->     | t1 < t2   = makeOrTrans ts1 ts2' >>= \ts -> return (tr1:ts)->     | t1 > t2   = makeOrTrans ts1' ts2 >>= \ts -> return (tr2:ts)->     | otherwise = remBuildOne (SReOr s1 s2) >>= \t ->->                       makeOrTrans ts1 ts2 >>= \ts ->->                           return ((t1,t):ts)--> makeCatTrans :: (ReVars m t) => [(t, SimplRe t)]->                       -> SimplRe t -> ReM m t [(t, SimplRe t)]-> makeCatTrans [] _->     = return []-> makeCatTrans ((t,s):ts) next->     = do->        s'  <- remBuildOne (SReCat s next)->        ts' <- makeCatTrans ts next->        return ((t,s'):ts')---Recursive Dfa--> data RDfa t->   = RDfa Bool [(t, RDfa t)]--> matchRecursiveDfa :: (Ord t) => RDfa t -> [t] -> Bool-> matchRecursiveDfa (RDfa final trans) []->   = final-> matchRecursiveDfa (RDfa final trans) (x:xs)->   = case [ s | (t, s) <- trans, t == x ] of->       []    -> False->       (s:_) -> matchRecursiveDfa s xs--> remMakeRecursiveDfa :: (ReVars m t) => SimplRe t -> ReM m t (RDfa t)-> remMakeRecursiveDfa start->   = do max1 <- gets resNext->        fwd <- gets resFwdMap->        let max = max1 - 1->            stateArray = A.array (0,max)->               [ (i, makeState stateArray fwd i) | i <- [0..max] ]->        return (stateArray A.! start)                              -- PROBLEM->   where->       makeState :: (Ord t) => A.Array (SimplRe t) (RDfa t) ->->                       M.Map (SimplRe t) (ReInfo t) ->->                       SimplRe t -> RDfa t->       makeState stateArray fwd s->         = RDfa (dfaFinal dfastate) [ (t, stateArray A.! ts)        -- PROBLEM->               | (t, ts) <- dfaTrans dfastate ]->         where->               Just reinfo = M.lookup s fwd                          -- PROBLEM->               Just dfastate = reiDfa reinfo---Code generation.  This is very, very ugly.--> data BinTree a = BTZ | BTB (BinTree a) a (BinTree a) deriving (Show)--> listToBinTree :: [a] -> BinTree a-> listToBinTree l->  = listToBinTree' (length l) l->  where->       listToBinTree' _ [] = BTZ->       listToBinTree' n ls->         = BTB (listToBinTree' n2 (take n2 ls)) t (listToBinTree' (n-n2-1) ts)->         where->               n2 = n `div` 2->               t:ts = drop n2 ls--> remCodeGen :: (ReVars m t) => SimplRe t -> ReM m t ([t] -> Bool)-> remCodeGen start->  = do max1 <- gets resNext->       fwd <- gets resFwdMap->       let max = max1 - 1->           stateArray = A.array (0,max)->               [ (i, makeState stateArray fwd i) | i <- [0..max] ]->       return $ (stateArray A.! start)                              -- PROBLEM->  where->       globalFail = False->       globalSucc = True->->       makeState :: (Ord t) => A.Array (SimplRe t) ([t] -> Bool) ->->                       M.Map (SimplRe t) (ReInfo t) ->->                       SimplRe t -> ([t] -> Bool)->       makeState stateArray fwd s->         | dfaFinal dfastate->               = \ts -> -- trace ("In state " ++ show s) $->                       case ts of->                           []     -> globalSucc->                           (t:ts) -> transition t ts->         | otherwise->               = \ts -> -- trace ("In state " ++ show s) $->                       case ts of->                           []     -> globalFail->                           (t:ts) -> transition t ts->         where->               Just reinfo = M.lookup s fwd                         -- PROBLEM->               Just dfastate = reiDfa reinfo->->               transition t ts->                 = transition' (listToBinTree (dfaTrans dfastate)) t ts->                 where->                       transition' BTZ = \t ts -> globalFail->                       transition' (BTB BTZ (x,st) BTZ)->                         = \t ts ->->                               if x == t then (stateArray A.! st) ts  -- PROBLEM->                               else globalFail->                       transition' (BTB l (x,st) r)->                         = \t ts ->->                               if t < x then transition' l t ts->                               else if t > x then transition' r t ts->                               else (stateArray A.! st) ts--Debug code.  Note that we need some extra constraints so we can-actually show regular expression states.--> class (ReVars m t, MonadIO m, Show t) => ReVarsIO m t where { }-> instance (ReVars m t, MonadIO m, Show t) => ReVarsIO m t where { }--> remDump :: (ReVarsIO m t) => ReM m t ()-> remDump->   = do states <- gets (M.toList . resFwdMap)->        remDumpStates states->   where->       remDumpStates [] = return ()->       remDumpStates ((s,sr):ss)->         = do  info <- remLookupFwd s->               liftIO . putStrLn $ show s ++ ": " ++ show sr->               remDumpStates ss--> remDumpDfa :: (ReVarsIO m t) => SimplRe t -> ReM m t ()-> remDumpDfa start->   = do states <- gets (nodups . L.sort . resStatesDone)->        liftIO (putStrLn $ "Initial state: " ++ show start)->        remDumpStates states->   where->       nodups [] = []->       nodups (x:xs)->         = x : nodups (dropWhile (==x) xs)->       remDumpStates [] = return ()->       remDumpStates (s:ss)->         = do  info <- remLookupFwd s->               let Just dfaState = reiDfa info->               liftIO . putStrLn $ show s ++ ": " ++ show dfaState->               remDumpStates ss--> remTestBuild :: (ReVarsIO m t) => Re t -> m ()-> remTestBuild re->  = remRun testBuild->  where->    testBuild->       = do    s <- remBuild re->               liftIO . putStrLn $ "Initial node: " ++ show s->               remDump--> remTestDfa :: (ReVarsIO m t) => Re t -> m ()-> remTestDfa re->  = remRun testDfa->  where->    testDfa->       = do    s <- remBuild re->               remMakeDfa s->               remDumpDfa s--Wrapper--> makeDfa :: (Ord t) => Re t -> RDfa t-> makeDfa re->   = runIdentity . remRun $ builder->   where->       builder->         = do  s <- remBuild re->               remMakeDfa s->               remMakeRecursiveDfa s--> makeCode :: (Ord t) => Re t -> [t] -> Bool-> makeCode re->   = runIdentity . remRun $ builder->   where->       builder->         = do  s <- remBuild re->               remMakeDfa s->               remCodeGen s--> matchRe :: (Ord t) => Re t -> [t] -> Bool-> matchRe re->   = makeCode re--> matchRe2 :: (Ord t) => Re t -> [t] -> Bool-> matchRe2 re->   = matchRecursiveDfa (makeDfa re)--Test cases--> re1 :: Re Char-> re1 = ReOr [ReStar (ReCat [re0, re01]), ReStar (ReCat [re01, re0])]->     where->       re01 = ReOr [re0, re1]->       re0 = ReTerm "0"->       re1 = ReTerm "1"--[+\-]?{digit}*(\.{digit}+)?([eE][+\-]?{digit}+)?--> re2 :: Re Char-> re2 = ReCat [ReOpt (alt "+-"),->       ReOr [ReCat [digits1, ReOpt (ReCat [dot, digits0])],->             ReCat [digits0, dot, digits1]],->       ReOpt (ReCat [alt "eE", ReOpt (alt "+-"), digits1])]->     where->       alt cs = ReOr $ map (\c -> ReTerm [c]) cs->       digits0 = ReStar digit->       digits1 = RePlus digit->       digit = alt "0123456789"->       dot = ReTerm "."-
− Swish/HaskellRDF/GraphClass.hs 
@@ -1,271 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}-----------------------------------------------------------------------------------
---  $Id: GraphClass.hs,v 1.16 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphClass
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a Labelled Directed Graph and Label classes,
---  and the Arc datatype.
---
---------------------------------------------------------------------------------
-
-------------------------------------------------------------
--- Define LDGraph, arc and related classes and types
-------------------------------------------------------------
-
-module Swish.HaskellRDF.GraphClass
-    ( LDGraph(..), replaceArcs
-    , Label(..)
-    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
-    , Selector
-    , hasLabel, arcLabels
-    )
-where
-
-import Swish.HaskellUtils.ListHelpers
-    ( subset )
-
-import Swish.HaskellUtils.FunctorM
-    ( FunctorM(..) )
-
-import Data.List
-    ( nub, union, (\\) )
-
---------------------------------
---  Labelled Directed Graph class
---------------------------------
---
---  Minimum required implementation:  setArcs, getArcs
---
---  NOTE:  I wanted to declare this as a subclass of Functor, but
---  the constraint on the label type seems to prevent that.
---  So I've just declared specific instances to be Functors.
-class (Eq (lg lb), Eq lb ) => LDGraph lg lb
-    where
-    --  empty graph
-    --  emptyGr     :: lg lb    [[[TODO?]]]
-    --  component-level operations
-    setArcs     :: [Arc lb] -> lg lb -> lg lb       -- setarcs [arcs] in g2 -> g3
-    getArcs     :: lg lb -> [Arc lb]                -- g1 -> [arcs]
-    --  extract arcs from a graph
-    extract     :: Selector lb -> lg lb -> lg lb    -- select f1 from g2 -> g3
-    extract sel = update (filter sel)
-    --  graph-level operations
-    add         :: lg lb -> lg lb -> lg lb          -- g1 + g2 -> g3
-    add    addg = update (union (getArcs addg))
-    delete      :: lg lb -> lg lb -> lg lb          -- g2 - g1 -> g3
-    delete delg = update (flip (\\) (getArcs delg))
-    --  enumerate distinct labels contained in a graph
-    labels      :: lg lb -> [lb]      -- g1 -> [labels]
-    labels g    = foldl union [] (map arcLabels (getArcs g))
-    --  enumerate distinct labels contained in a graph
-    nodes       :: lg lb -> [lb]      -- g1 -> [labels]
-    nodes g     = foldl union [] (map arcNodes (getArcs g))
-    --  test for graph containment in another
-    containedIn :: lg lb -> lg lb -> Bool           -- g1 <= g2?
-    -- g1 update arcs in a graph using a supplied function:
-    update      :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb
-    update f g  = setArcs ( f (getArcs g) ) g
-
--- |Function to replace arcs in a graph with a given list of arcs
-replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb
-replaceArcs gr as = update (const as) gr
-
----------------
---  Label class
----------------
---
---  A label may have a fixed binding, which means that the label identifies (is) a
---  particular graph node, and different such labels are always distinct nodes.
---  Alternatively, a label may be unbound (variable), which means that it is a
---  placeholder for an unknown node label.  Unbound node labels are used as
---  graph-local identifiers for indicating when the same node appears in
---  several arcs.
---
---  For the purposes of graph-isomorphism testing, fixed labels are matched when they
---  are the same.  Variable labels may be matched with any other variable label.
---  Our definition of isomorphism (for RDF graphs) does not match variable labels
---  with fixed labels.
-
-class (Eq lb, Show lb, Ord lb) => Label lb where
-    labelIsVar  :: lb -> Bool           -- does this node have a variable binding?
-    labelHash   :: Int -> lb -> Int     -- calculate hash of label using supplied seed
-    getLocal    :: lb -> String         -- extract local id from variable node
-    makeLabel   :: String -> lb         -- make label value given local id
-    -- compare     :: lb -> lb -> Ordering
-    -- compare l1 l2 = compare (show l1) (show l2)
-
-------------
---  Arc type
-------------
-
-data Arc lb = Arc { asubj, apred, aobj :: lb }
-    deriving Eq
-
-arcSubj :: Arc lb -> lb
-arcSubj = asubj
-
-arcPred :: Arc lb -> lb
-arcPred = apred
-
-arcObj :: Arc lb -> lb
-arcObj = aobj
-
-arc :: lb -> lb -> lb -> Arc lb
-arc s p o = Arc s p o
-
-arcToTriple :: Arc lb -> (lb,lb,lb)
-arcToTriple a = (asubj a,apred a,aobj a)
-
-arcFromTriple :: (lb,lb,lb) -> Arc lb
-arcFromTriple (s,p,o) = Arc s p o
-
-instance Ord lb => Ord (Arc lb) where
-    compare (Arc s1 p1 o1) (Arc s2 p2 o2) =
-        if cs /= EQ then cs else
-        if cp /= EQ then cp else co
-        where
-            cs = compare s1 s2
-            cp = compare p1 p2
-            co = compare o1 o2
-    (Arc s1 p1 o1) <= (Arc s2 p2 o2) =
-        if (s1 /= s2) then (s1 <= s2) else
-        if (p1 /= p2) then (p1 <= p2) else (o1 <= o2)
-
-instance Functor Arc where
-    -- fmap :: (lb -> l2) -> Arc lb -> Arc l2
-    fmap f (Arc s p o) = Arc (f s) (f p) (f o)
-
-instance FunctorM Arc where
-    -- fmapM :: (lb -> m l2) -> Arc lb -> m (Arc l2)
-    fmapM f (Arc s p o) =
-        do  { s' <- f s
-            ; p' <- f p
-            ; o' <- f o
-            ; return $ Arc s' p' o'
-            }
-
-instance (Show lb) => Show (Arc lb) where
-    show (Arc lb1 lb2 lb3) =
-        "("++(show lb1)++","++(show lb2)++","++(show lb3)++")"
-
-type Selector lb = Arc lb -> Bool
-
-hasLabel :: (Eq lb) => lb -> Arc lb -> Bool
-hasLabel lbv (Arc lb1 lb2 lb3) = (lbv==lb1) || (lbv==lb2) || (lbv==lb3)
-
-arcLabels :: Arc lb -> [lb]
-arcLabels (Arc lb1 lb2 lb3) = [lb1,lb2,lb3]
-
-arcNodes :: Arc lb -> [lb]
-arcNodes (Arc lb1 _ lb3) = [lb1,lb3]
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphClass.hs,v $
--- $Author: graham $
--- $Revision: 1.16 $
--- $Log: GraphClass.hs,v $
--- Revision 1.16  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.15  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.14  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.13  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.12  2003/06/10 17:38:34  graham
--- Remove some unneeded calss constraints from data type declarations
--- Reworked NSGraph to be an instance of Functor, replacing function
--- gmap with fmap.  Graph formulae are still not handled well:  the data types
--- will need re-working so that a "Formula lb" type constructor can be
--- introduced having the correct (* -> *) kind to be a Functor.
---
--- Revision 1.11  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.10  2003/05/30 15:04:56  graham
--- Fix references to defunct GraphHelpers module
---
--- Revision 1.9  2003/05/29 01:50:56  graham
--- More performance tuning, courtesy of GHC profiler.
--- All modules showing reasonable performance now.
---
--- Revision 1.8  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.7  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.6  2003/05/23 16:29:20  graham
--- Partial code cleanup:
--- - Arc is an alebraic type
--- - Arc is an instance of Functor
--- - add gmap function to Graph interface
--- - remove some duplicate functions from GraphMatch
--- This in preparation for adding graph merge facility with
--- blank node renaming.
---
--- Revision 1.5  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.4  2003/04/10 13:35:34  graham
--- Separated GraphMatch logic from GraphMem
---
--- Revision 1.3  2003/04/10 08:36:06  graham
--- Graph matching passes battery of new tests
--- Started work on RDF graph
---
--- Revision 1.2  2003/03/31 20:52:23  graham
--- Restructure graph matching to deal with same unbound node names in
--- different graphs.  It shows signs that it might be working now.
--- More testing is needed.
---
--- Revision 1.1  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
− Swish/HaskellRDF/GraphMatch.hs 
@@ -1,741 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}
-{-# OPTIONS -XTypeSynonymInstances #-}
-{-# OPTIONS -XMultiParamTypeClasses #-}
-
---------------------------------------------------------------------------------
---  $Id: GraphMatch.hs,v 1.19 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphMatch
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains graph-matching logic.
---
---  The algorithm used is derived from a paper on RDF graph matching
---  by Jeremy Carroll [1].
---
---  [1] http://www.hpl.hp.com/techreports/2001/HPL-2001-293.html
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.GraphMatch
-      ( graphMatch,
-        -- The rest exported for testing only
-        LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..),
-        ScopedLabel(..), makeScopedLabel, makeScopedArc,
-        LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
-        labelIsVar, labelHash,
-        mapLabelIndex, setLabelHash, newLabelMap,
-        graphLabels, assignLabelMap, newGenerationMap,
-        graphMatch1, graphMatch2, equivalenceClasses, reclassify
-      ) where
-
-import Swish.HaskellUtils.LookupMap
-import Swish.HaskellUtils.ListHelpers
-import Swish.HaskellUtils.MiscHelpers
-import Swish.HaskellUtils.TraceHelpers( trace, traceShow )
-import Swish.HaskellRDF.GraphClass
-import Data.Maybe( isJust )
-import Data.List( nub, sortBy, partition )
-import qualified Data.List
-
---------------------------
---  Label index value type
---------------------------
---
---  LabelIndex is a unique value assigned to each label, such that
---  labels with different values are definitely different values
---  in the graph;  e.g. do not map to each other in the graph
---  bijection.  The first member is a generation counter that
---  ensures new values are distinct from earlier passes.
-
-type LabelIndex = (Int,Int)
-
-nullLabelVal :: LabelIndex
-nullLabelVal = (0,0)
-
------------------------
---  Label mapping types
------------------------
-
-data (Label lb) => GenLabelEntry lb lv = LabelEntry lb lv
-
-type LabelEntry lb = GenLabelEntry lb LabelIndex
-
-instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
-    => LookupEntryClass (GenLabelEntry lb lv) lb lv where
-    keyVal   (LabelEntry k v) = (k,v)
-    newEntry (k,v)            = LabelEntry k v
-
-instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
-    => Show (GenLabelEntry lb lv) where
-    show = entryShow
-
-instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
-    => Eq (GenLabelEntry lb lv) where
-    (==) = entryEq
-
---  Type for label->index lookup table
-data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =
-    LabelMap Int (LookupMap (GenLabelEntry lb lv))
-
-type LabelMap lb = GenLabelMap lb LabelIndex
-
-instance (Label lb) => Show (LabelMap lb) where
-    show = showLabelMap
-
-instance (Label lb) => Eq (LabelMap lb) where
-    LabelMap gen1 lmap1 == LabelMap gen2 lmap2 =
-        (gen1 == gen2) && (es1 `equiv` es2)
-        where
-            es1 = listLookupMap lmap1
-            es2 = listLookupMap lmap2
-
-emptyMap :: (Label lb) => LabelMap lb
-emptyMap = LabelMap 1 $ makeLookupMap []
-
---------------------------
---  Equivalence class type
---------------------------
---
---  Type for equivalence class description
---  (An equivalence class is a collection of labels with
---  the same LabelIndex value.)
-
-type EquivalenceClass lb = (LabelIndex,[lb])
-
-ecIndex :: EquivalenceClass lb -> LabelIndex
-ecIndex = fst
-
-ecLabels :: EquivalenceClass lb -> [lb]
-ecLabels = snd
-
-ecSize :: EquivalenceClass lb -> Int
-ecSize (_,ls) = length ls
-
-ecRemoveLabel :: (Label lb) => EquivalenceClass lb -> lb -> EquivalenceClass lb
-ecRemoveLabel (lv,ls) l = (lv,Data.List.delete l ls)
-
-------------------------------------------------------------
---  Augmented graph label value - for graph matching
-------------------------------------------------------------
---
---  This instance of class label adds a graph identifier to
---  each variable label, so that variable labels from
---  different graphs are always seen as distinct values.
---
---  The essential logic added by this class instance is embodied
---  in the eq and hash functions.  Note that variable label hashes
---  depend only on the graph in which they appear, and non-variable
---  label hashes depend only on the variable.  Label hash values are
---  used when initializing a label equivalence-class map (and, for
---  non-variable labels, also for resolving hash collisions).
-
-data (Label lb) => ScopedLabel lb = ScopedLabel Int lb
-
-makeScopedLabel :: (Label lb) => Int -> lb -> ScopedLabel lb
-makeScopedLabel scope lab = ScopedLabel scope lab
-
-makeScopedArc :: (Label lb) => Int -> Arc lb -> Arc (ScopedLabel lb)
-makeScopedArc scope a1 = arc (s arcSubj a1) (s arcPred a1) (s arcObj a1)
-    where
-        s f a = (ScopedLabel scope (f a))
-
-instance (Label lb) => Label (ScopedLabel lb) where
-    getLocal  lab    = error $ "getLocal for ScopedLabel: "++show lab
-    makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam
-    labelIsVar (ScopedLabel _ lab)   = labelIsVar lab
-    labelHash seed (ScopedLabel scope lab)
-        | labelIsVar lab    = hash seed $ (show scope)++"???"
-        | otherwise         = labelHash seed lab
-
-instance (Label lb) => Eq (ScopedLabel lb) where
-    (ScopedLabel s1 l1) == (ScopedLabel s2 l2)
-        = ( l1 == l2 ) && (s1 == s2)
-
-instance (Label lb) => Show (ScopedLabel lb) where
-    show (ScopedLabel s1 l1) = (show s1) ++ ":" ++ (show l1)
-
-instance (Label lb) => Ord (ScopedLabel lb) where
-    compare (ScopedLabel s1 l1) (ScopedLabel s2 l2) =
-        case (compare s1 s2) of
-            LT -> LT
-            EQ -> compare l1 l2
-            GT -> GT
-
---------------
---  graphMatch
---------------
---
---  Graph matching function accepting two lists of arcs and
---  returning a node map if successful
---
---  matchable
---          is a function that tests for additional constraints
---          that may prevent the matching of a supplied pair
---          of nodes.  Returns True if the supplied nodes may be
---          matched.  (Used in RDF graph matching for checking
---          that formula assignments are compatible.)
---  gs1     is the first of two graphs to be compared,
---          supplied as a list of arcs.
---  gs2     is the second of two graphs to be compared,
---          supplied as a list of arcs.
---
---  returns a label map that maps each label to an equivalence
---          class identifier, or Nothing if the graphs cannot be
---          matched.
-
-graphMatch :: (Label lb) =>
-    (lb -> lb -> Bool) -> [Arc lb] -> [Arc lb]
-    -> (Bool,LabelMap (ScopedLabel lb))
-graphMatch matchable gs1 gs2 =
-    let
-        sgs1    = {- trace "sgs1 " $ -} map (makeScopedArc 1) gs1
-        sgs2    = {- trace "sgs2 " $ -} map (makeScopedArc 2) gs2
-        ls1     = {- traceShow "ls1 " $ -} graphLabels sgs1
-        ls2     = {- traceShow "ls2 " $ -} graphLabels sgs2
-        lmap    = {- traceShow "lmap " $ -}
-                  newGenerationMap $
-                  assignLabelMap ls1 $
-                  assignLabelMap ls2 emptyMap
-        ec1     = {- traceShow "ec1 " $ -} equivalenceClasses lmap ls1
-        ec2     = {- traceShow "ec2 " $ -} equivalenceClasses lmap ls2
-        ecpairs = zip (pairSort ec1) (pairSort ec2)
-        matchableScoped (ScopedLabel _ l1) (ScopedLabel _ l2) = matchable l1 l2
-        match   = graphMatch1 False matchableScoped sgs1 sgs2 lmap ecpairs
-    in
-        if (length ec1) /= (length ec2) then (False,emptyMap) else match
-
---  Recursive graph matching function
---  This function assumes that no variable label appears in both graphs.
---  (Function graphMatch, which calls this, ensures that all variable
---  labels are distinct.)
---
---  matchable
---          is a function that tests for additional constraints
---          that may prevent the matching of a supplied pair
---          of nodes.  Returns True if the supplied nodes may be
---          matched.
---  guessed is True if a guess has been used before trying this comparison,
---          False if nodes are being matched without any guesswork.
---  gs1     is the first of two lists of arcs (triples) to be compared
---  gs2     is the second of two lists of arcs (triples) to be compared
---  lmap    is the map so far used to map label values to equivalence
---          class values
---  ecpairs list of pairs of corresponding equivalence classes of nodes
---          from gs1 and gs2 that have not been confirmed in 1:1
---          correspondence with each other.
---          Each pair of equivalence classes contains nodes that must
---          be placed in 1:1 correspondence with each other.
---
---  returns a pair (match,map), where 'match' is Tue if the supplied
---          sets of arcs can be matched, in which case 'map' is a
---          corresponding map from labels to equivalence class identifiers.
---          When 'match' is False, 'map' is the most detailed equivalence
---          class map obtained before a mismatch was detected or a guess
---          was required -- this is intended to help identify where the
---          graph mismatch may be.
---
--- [[[TODO:  replace Equivalence class pair by (index,[lb],[lb]) ?]]]
--- [[[TODO:  possible optimization:  the graphMapEq test should be
---           needed only if graphMatch2 has been used to guess a
---           mapping;  either (a) supply flag saying guess has been
---           used, or (b) move test to graphMatch2 and use different
---           test to prevent rechecking for each guess used.]]]
-
-graphMatch1 :: (Label lb) =>  Bool -> (lb -> lb -> Bool)
-    -> [Arc lb] -> [Arc lb]
-    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-    -> (Bool,(LabelMap lb))
-graphMatch1 guessed matchable gs1 gs2 lmap ecpairs =
-    let
-        (secs,mecs) = partition uniqueEc ecpairs
-        uniqueEc ( (_,[_])  , (_,[_])  ) = True
-        uniqueEc (  _       ,  _       ) = False
-        doMatch  ( (_,[l1]) , (_,[l2]) ) = labelMatch matchable lmap l1 l2
-        ecEqSize ( (_,ls1)  , (_,ls2)  ) = (length ls1) == (length ls2)
-        ecSize   ( (_,ls1)  , _        ) = length ls1
-        ecCompareSize ec1 ec2 = compare (ecSize ec1) (ecSize ec2)
-        (lmap',mecs',newEc,matchEc) = reclassify gs1 gs2 lmap mecs
-        match2 = graphMatch2 matchable gs1 gs2 lmap $ sortBy ecCompareSize mecs
-    in
-        -- trace ("graphMatch1\nsingle ECs:\n"++show secs++
-        --                   "\nmultiple ECs:\n"++show mecs++
-        --                   "\n\n") $
-        --  if mismatch in singleton equivalence classes, fail
-        if not $ all doMatch secs then (False,lmap)
-        else
-        --  if no multi-member equivalence classes,
-        --  check and return label map supplied
-        -- trace ("graphMatch1\ngraphMapEq: "++show (graphMapEq lmap gs1 gs2)) $
-        if null mecs then (graphMapEq lmap gs1 gs2,lmap)
-        else
-        --  if size mismatch in equivalence classes, fail
-        -- trace ("graphMatch1\nall ecEqSize mecs: "++show (all ecEqSize mecs)) $
-        if not $ all ecEqSize mecs then (False,lmap)
-        else
-        --  invoke reclassification, and deal with result
-        if not matchEc then (False,lmap)
-        else
-        if newEc then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'
-        else
-        --  if guess does not result in a match, return supplied label map
-        if fst match2 then match2 else (False,lmap)
-
---  Auxiliary graph matching function
---  This function is called when deterministic decomposition of node
---  mapping equivalence classes has run its course.
---
---  It picks a pair of equivalence classes in ecpairs, and arbitrarily matches
---  pairs of nodes in those equivalence classes, recursively calling the
---  graph matching function until a suitable node mapping is discovered
---  (success), or until all such pairs have been tried (failure).
---
---  This function represents a point to which arbitrary choices are backtracked.
---  The list comprehension 'glp' represents the alternative choices at the
---  point of backtracking
---
---  The selected pair of nodes are placed in a new equivalence class based on their
---  original equivalence class value, but with a new NodeVal generation number.
-
-graphMatch2 :: (Label lb) => (lb -> lb -> Bool)
-    -> [Arc lb] -> [Arc lb]
-    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-    -> (Bool,(LabelMap lb))
-graphMatch2 matchable gs1 gs2 lmap ((ec1@(ev1,ls1),ec2@(ev2,ls2)):ecpairs) =
-    let
-        (_,v1) = ev1
-        (_,v2) = ev2
-        --  Return any equivalence-mapping obtained by matching a pair
-        --  of labels in the supplied list, or Nothing.
-        try []            = (False,lmap)
-        try ((l1,l2):lps) = if equiv try1 l1 l2 then try1 else try lps
-            where
-                try1     = graphMatch1 True matchable gs1 gs2 lmap' ecpairs'
-                lmap'    = newLabelMap lmap [(l1,v1),(l2,v1)]
-                ecpairs' = ((ev',[l1]),(ev',[l2])):ec':ecpairs
-                ev'      = mapLabelIndex lmap' l1
-                ec'      = (ecRemoveLabel ec1 l1,ecRemoveLabel ec2 l2)
-                -- [[[TODO: replace this: if isJust try ?]]]
-                equiv (False,_)   _  _  = False
-                equiv (True,lmap) l1 l2 =
-                    (mapLabelIndex m1 l1) == (mapLabelIndex m2 l2)
-                    where
-                        m1 = remapLabels gs1 lmap [l1]
-                        m2 = remapLabels gs2 lmap [l2]
-        --  glp is a list of label-pair candidates for matching,
-        --  selected from the first label-equivalence class.
-        --  NOTE:  final test is call of external matchable function
-        glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ]
-    in
-        assert (ev1==ev2) "GraphMatch2: Equivalence class value mismatch" $
-        try glp
-
-----------------------
---  LabelMap functions
-----------------------
-
-----------------
---  showLabelMap
-----------------
---
---  Returns a string representation  of a LabelMap value
-
-showLabelMap :: (Label lb) => LabelMap lb -> String
-showLabelMap (LabelMap gn lmap) =
-    "LabelMap gen="++(Prelude.show gn)++", map="++
-    foldl (++) "" ((map ("\n    "++)) (map Prelude.show es ))
-    where
-        es = listLookupMap lmap
-
------------------
---  mapLabelIndex
------------------
---
---  Map a label to its corresponding label index value in the supplied LabelMap
-
-mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
-mapLabelIndex (LabelMap _ lxms) lb = mapFind nullLabelVal lb lxms
-
---------------
---  labelMatch
---------------
---
---  Confirm that a given pair of labels are matchable, and are
---  mapped to the same value by the supplied label map
-
-labelMatch :: (Label lb)
-    =>  (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
-labelMatch matchable lmap l1 l2 =
-    (matchable l1 l2) && ((mapLabelIndex lmap l1) == (mapLabelIndex lmap l1))
-
----------------
---  newLabelMap
----------------
---
---  Replace selected values in a label map with new values from the supplied
---  list of labels and new label index values.  The generation number is
---  supplied from the current label map.  The generation number in the
---  resulting label map is incremented.
-
-newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
-newLabelMap (LabelMap g f) [] = (LabelMap (g+1) f) -- new generation
-newLabelMap lmap (lv:lvs)     = setLabelHash (newLabelMap lmap lvs) lv
-
-----------------
---  setLabelHash
-----------------
---
---  setLabelHash replaces a label and its associated value in a label map
---  with a new value using the supplied hash value and the current
---  LabelMap generation number.  If the key is not found, then no change
---  is made to the label map.
-
-setLabelHash :: (Label lb)
-    => LabelMap lb -> (lb,Int) -> LabelMap lb
-setLabelHash  (LabelMap g lmap) (lb,lh) =
-    LabelMap g ( mapReplaceAll lmap $ newEntry (lb,(g,lh)) )
-
---------------------
---  newGenerationMap
---------------------
---
---  Increment generation of label map.
---  Returns a new label map identical to the supplied value
---  but with an incremented generation number.
-
-newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb
-newGenerationMap (LabelMap g lvs) = (LabelMap (g+1) lvs)
-
-------------------
---  assignLabelMap
-------------------
---
---  Scan label list, assigning initial label map values,
---  adding new values to the label map supplied.
---
---  Label map values are assigned on the basis of the
---  label alone, without regard for it's connectivity in
---  the graph.  (cf. reClassify)
---
---  All variable node labels are assigned the same initial
---  value, as they may be matched with each other.
-
-assignLabelMap :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
-assignLabelMap [] lmap      = lmap
-assignLabelMap (n:ns) lmap  = assignLabelMap ns (assignLabelMap1 n lmap)
-
-assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb
-assignLabelMap1 lab (LabelMap g lvs) = LabelMap g lvs'
-    where
-        lvs' = (mapAddIfNew lvs $ newEntry (lab,(g,initVal lab)))
-
---  Calculate initial value for a node
-
-initVal :: (Label lb) => lb -> Int
-initVal n = hashVal 0 n
-
-hashVal :: (Label lb) => Int -> lb -> Int
-hashVal seed lab =
-    if (labelIsVar lab) then (hash seed "???") else (labelHash seed lab)
-
-----------------------
---  equivalenceClasses
-----------------------
---
---  lmap    label map
---  ls      list of nodes to be reclassified
---
---  return  list of equivalence classes of the supplied labels under
---          the supplied label map.
-
-equivalenceClasses :: (Label lb) => LabelMap lb -> [lb] -> [EquivalenceClass lb]
-equivalenceClasses lmap ls =
-    pairGroup $ map labelPair ls
-    where
-        labelPair l = (mapLabelIndex lmap l,l)
-
---------------
---  reclassify
---------------
---
---  Reclassify labels
---
---  Examines the supplied label equivalence classes (based on the supplied
---  label map), and evaluates new equivalence subclasses based on node
---  values and adjacency (for variable nodes) and rehashing
---  (for non-variable nodes).
---
---  Note, assumes that all all equivalence classes supplied are
---  non-singletons;  i.e. contain more than one label.
---
---  gs1     is the first of two lists of arcs (triples) to perform a
---          basis for reclassifying the labels in the first equivalence
---          class in each pair of 'ecpairs'.
---  gs2     is the second of two lists of arcs (triples) to perform a
---          basis for reclassifying the labels in the second equivalence
---          class in each pair of 'ecpairs'.
---  lmap    is a label map used for classification of the labels in
---          the supplied equivalence classes.
---  ecpairs a list of pairs of corresponding equivalence classes of
---          nodes from gs1 and gs2 that have not been confirmed
---          in 1:1 correspondence with each other.
---
---  return  a quadruple of:
---          (a) a revised label map reflecting the reclassification,
---          (b) a new list of equivalence class pairs based on the
---          new node map, and
---          (c) if the reclassification partitions any of the
---          supplied equivalence classes then True, else False.
---          any of the supplied equivalence classes
---          (d) if reclassification results in each equivalence class
---          being split same-sized equivalence classes in the two graphs,
---          then True, otherwise False.
-
-reclassify :: (Label lb) =>
-    [Arc lb] -> [Arc lb]
-    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-    -> (LabelMap lb,[(EquivalenceClass lb,EquivalenceClass lb)],Bool,Bool)
-reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =
-    assert (gen1==gen2) "Label map generation mismatch" $
-    (LabelMap gen1 lm',ecpairs',newPart,matchPart)
-    where
-        LabelMap gen1 lm1 =
-            remapLabels gs1 lmap $ foldl1 (++) $ map (ecLabels . fst) ecpairs
-        LabelMap gen2 lm2 =
-            remapLabels gs2 lmap $ foldl1 (++) $ map (ecLabels . snd) ecpairs
-        lm' = mapReplaceMap lm $ mapMerge lm1 lm2
-        -- ecGroups :: [([EquivalenceClass lb],[EquivalenceClass lb])]
-        ecGroups  = [ (remapEc ec1,remapEc ec2) | (ec1,ec2) <- ecpairs ]
-        ecpairs'  = concat $ map (uncurry zip) ecGroups
-        newPart   = or  $ map pairG1 lenGroups
-        matchPart = and $ map pairEq lenGroups
-        lenGroups = map subLength ecGroups
-        pairEq (p1,p2) = p1 == p2
-        pairG1 (p1,p2) = (p1 > 1) || (p2 > 1)
-        subLength (ls1,ls2) = (length ls1,length ls2)
-        remapEc ec = pairGroup $ map (newIndex lm') $ pairUngroup ec
-        newIndex lm (_,lab) = (mapFind nullLabelVal lab lm,lab)
-
----------------
---  remapLabels
----------------
---
---  Calculate a new index value for a supplied list of labels based on the
---  supplied label map and adjacency calculations in the supplied graph
---
---  gs      is a list of Arcs used for adjacency calculations when remapping
---  lmap    is a label map used for obtaining current label index values
---  ls      is a list of graph labels for which new mappings are to be
---          created and returned.
---  return  a new label map containing recalculated label index values
---          for the labels in ls.  The label map generation number is
---          incremented by 1 from the supplied 'lmap' value.
-
-remapLabels :: (Label lb) =>
-    [Arc lb] -> LabelMap lb -> [lb] -> LabelMap lb
-remapLabels gs lmap@(LabelMap gen _) ls =
-    LabelMap gen' (LookupMap newEntries)
-    where
-        gen'                = gen+1
-        newEntries          = [ newEntry (l, (gen',newIndex l)) | l <- ls ]
-        newIndex l
-            | labelIsVar l  = mapAdjacent l     -- adjacency classifies variable labels
-            | otherwise     = hashVal gen l     -- otherwise rehash (to disentangle collisions)
-        mapAdjacent l       = ( sum (sigsOver l) ) `rem` hashModulus
-        sigsOver l          = select (hasLabel l) gs (arcSignatures lmap gs)
-
------------------------------
---  Graph auxiliary functions
------------------------------
-
----------------
---  graphLabels
----------------
---
---  Return list of distinct labels used in a graph
-
-graphLabels :: (Label lb) => [Arc lb] -> [lb]
-graphLabels gs = nub $ concat $ map arcLabels gs
-
-{-  OLD CODE:
-graphLabels gs = graphLabels1 gs []
-
-graphLabels1 (t:gs) ls = graphLabels1 gs $
-                         foldl (flip addSetElem) ls (arcLabels t)
-graphLabels1 [] ls     = ls
--}
-
--- addSetElem ::  lb -> [lb] -> [lb]
-
------------------
---  arcSignatures
------------------
---
---  Calculate a signature value for each arc that can be used in constructing an
---  adjacency based value for a node.  The adjacancy value for a label is obtained
---  by summing the signatures of all statements containing that label.
---
---  lmap    is a label map used for obtaining current label index values
---  gs      is the list of arcs for which signaturews are calculated
---  return  a list of signature values in correspondence with gs
-
-arcSignatures :: (Label lb) => LabelMap lb -> [Arc lb] -> [Int]
-arcSignatures lmap gs =
-    map (sigCalc . arcToTriple) gs
-    where
-        sigCalc (s,p,o)     =
-            ( (labelVal2 s) +
-              (labelVal2 p)*3 +
-              (labelVal2 o)*5 ) `rem` hashModulus
-        labelVal l          = mapLabelIndex lmap l
-        labelVal2           = (\v -> (fst v) * (snd v) ) . labelVal
-
-------------
---  graphMap
-------------
---
---  Return new graph that is supplied graph with every node/arc
---  mapped to a new value according to the supplied function.
---
---  Used for testing for graph equivalence under a supplied
---  label mapping;  e.g.
---
---    if ( graphMap nodeMap gs1 ) `equiv` ( graphMap nodeMap gs2 ) then (same)
-
-graphMap :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc LabelIndex]
-graphMap lmap = map $ fmap (mapLabelIndex lmap) -- graphMapStmt
-
---------------
---  graphMapEq
---------------
---
---  Compare a pair of graphs for equivalence under a given mapping
---  function.
---
---  This is used to perform the ultimate test that two graphs are
---  indeed equivalent:  guesswork in graphMatch2 means that it is
---  occasionally possible to construct a node mapping that generates
---  the required singleton equivalence classes, but does not fully
---  reflect the topology of the graphs.
-
-graphMapEq :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc lb] -> Bool
-graphMapEq lmap gs1 gs2 = (graphMap lmap gs1) `equiv` (graphMap lmap gs2)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphMatch.hs,v $
--- $Author: graham $
--- $Revision: 1.19 $
--- $Log: GraphMatch.hs,v $
--- Revision 1.19  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.18  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.17  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.16  2003/10/24 21:03:25  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.15  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.14  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.13  2003/05/29 01:50:56  graham
--- More performance tuning, courtesy of GHC profiler.
--- All modules showing reasonable performance now.
---
--- Revision 1.12  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.11  2003/05/23 16:29:20  graham
--- Partial code cleanup:
--- - Arc is an alebraic type
--- - Arc is an instance of Functor
--- - add gmap function to Graph interface
--- - remove some duplicate functions from GraphMatch
--- This in preparation for adding graph merge facility with
--- blank node renaming.
---
--- Revision 1.10  2003/05/14 11:13:15  graham
--- Fixed bug in graph matching.
--- (A graph-equivalence check is needed to weed out false matches
--- caused by the "guessing" stage.)
---
--- Revision 1.9  2003/05/14 02:01:59  graham
--- GraphMatch recoded and almost working, but
--- there are a couple of
--- obscure bugs that are proving rather stubborn to squash.
---
--- Revision 1.8  2003/05/09 00:29:14  graham
--- Started to restructure graph matching code
---
--- Revision 1.7  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.6  2003/05/01 23:15:44  graham
--- GraphTest passes all tests using refactored LookupMap
--- Extensive changes to GraphMatch were required.
---
--- Revision 1.5  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.4  2003/04/11 18:12:10  graham
--- Renamed GraphHelpers to ListHelpers
--- LookupMapTest, GraphTest, RDFGraphTest all run OK
---
--- Revision 1.3  2003/04/11 18:04:49  graham
--- Rename GraphLookupMap to LookupMap:
--- GraphTest runs OK.
---
--- Revision 1.2  2003/04/10 16:47:04  graham
--- Minor code cleanup
---
--- Revision 1.1  2003/04/10 13:35:34  graham
--- Separated GraphMatch logic from GraphMem
---
− Swish/HaskellRDF/GraphMem.hs 
@@ -1,264 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}-{-# OPTIONS -XMultiParamTypeClasses #-}----------------------------------------------------------------------------------
---  $Id: GraphMem.hs,v 1.16 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphMem
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a simple memory-based graph instance.
---
---------------------------------------------------------------------------------
-
-------------------------------------------------------------
--- Simple labelled directed graph value
-------------------------------------------------------------
-
-module Swish.HaskellRDF.GraphMem
-    ( GraphMem(..)
-    , setArcs, getArcs, add, delete, extract, labels
-    , LabelMem(..)
-    , labelIsVar, labelHash
-      -- For debug/test:
-    , matchGraphMem
-    ) where
-
-import Swish.HaskellUtils.LookupMap
-import Swish.HaskellRDF.GraphClass
-import Swish.HaskellRDF.GraphMatch
-import Swish.HaskellUtils.MiscHelpers
-    ( hash )
-import Swish.HaskellUtils.FunctorM
-    ( FunctorM(..) )
-import Data.List
-    ( nub, union, (\\), group, sort, sortBy, any )
-import Data.Maybe
-    ( isJust )
-
------------------------------------------------------
---  Memory-based graph type and graph class functions
------------------------------------------------------
-
-data GraphMem lb = GraphMem { arcs :: [Arc lb] }
-
-instance (Label lb) => LDGraph GraphMem lb where
-    getArcs      = arcs
-    setArcs as g = g { arcs=as }
-    -- gmap f g = g { arcs = (map $ fmap f) (arcs g) }
-
-instance (Label lb) => Eq (GraphMem lb) where
-    (==) = graphEq
-
-instance (Label lb) => Show (GraphMem lb) where
-    show = graphShow
-
-instance Functor GraphMem where
-    fmap f g = GraphMem $ map (fmap f) (arcs g)
-
-instance FunctorM GraphMem where
-    fmapM f g =
-        do  { arcs <- mapM (fmapM f) (arcs g)
-            ; return $ GraphMem arcs
-            }
-
-graphShow   :: (Label lb) => GraphMem lb -> String
-graphShow g = "Graph:"++(foldr (++) "" (map ("\n    "++) (map show (arcs g))))
-
-toGraph :: (Label lb) => [Arc lb] -> GraphMem lb
-toGraph as = GraphMem { arcs=(nub as) }
-
------------
---  graphEq
------------
---
---  Return Boolean graph equality
-
-graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool
-graphEq g1 g2 = fst ( matchGraphMem g1 g2 )
-
------------------
---  matchGraphMem
------------------
---
---  GraphMem matching function accepting GraphMem value and returning
---  node map if successful
---
---  g1      is the first of two graphs to be compared
---  g2      is the second of two graphs to be compared
---
---  returns a label map that maps each label to an equivalence
---          class identifier, or Nothing if the graphs cannot be
---          matched.
-
-matchGraphMem :: (Label lb) => GraphMem lb -> GraphMem lb
-                            -> (Bool,LabelMap (ScopedLabel lb))
-matchGraphMem g1 g2 =
-    let
-        gs1     = arcs g1
-        gs2     = arcs g2
-        matchable l1 l2
-            | (labelIsVar l1) && (labelIsVar l2) = True
-            | (labelIsVar l1) || (labelIsVar l2) = False
-            | otherwise                          = l1 == l2
-    in
-        graphMatch matchable gs1 gs2
-
----------------
---  graphBiject
----------------
---
---  Return bijection between two graphs, or empty list
-{-
-graphBiject :: (Label lb) => GraphMem lb -> GraphMem lb -> [(lb,lb)]
-graphBiject g1 g2 = if null lmap then [] else zip (sortedls g1) (sortedls g2)
-    where
-        lmap        = graphMatch g1 g2
-        sortedls g  = map snd $
-                      (sortBy indexComp) $
-                      equivalenceClasses (graphLabels $ arcs g) lmap
-        classComp ec1 ec2 = indexComp (classIndexVal ec1) (classIndexVal ec2)
-        indexComp (g1,v1) (g2,v2)
-            | g1 == g2  = compare v1 v2
-            | otherwise = compare g1 g2
--}
-
-------------------------------------------------------------
---  Minimal graph label value - for testing
-------------------------------------------------------------
-
-data LabelMem
-    = LF String
-    | LV String
-
-instance Label LabelMem where
-    labelIsVar (LV _)   = True
-    labelIsVar _        = False
-    getLocal   (LV loc) = loc
-    getLocal   lab      = error "getLocal of non-variable label: "++(show lab)
-    makeLabel  loc      = LV loc
-    labelHash  seed lb  = hash seed (show lb)
-
-instance Eq LabelMem where
-    (LF l1) == (LF l2)  = l1 == l2
-    (LV l1) == (LV l2)  = l1 == l2
-    _ == _              = False
-
-instance Show LabelMem where
-    show (LF l1)        = "!"++l1
-    show (LV l2)        = "?"++l2
-
-instance Ord LabelMem where
-    compare l1 l2 = compare (show l1) (show l2)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphMem.hs,v $
--- $Author: graham $
--- $Revision: 1.16 $
--- $Log: GraphMem.hs,v $
--- Revision 1.16  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.15  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.14  2003/06/10 17:38:34  graham
--- Remove some unneeded calss constraints from data type declarations
--- Reworked NSGraph to be an instance of Functor, replacing function
--- gmap with fmap.  Graph formulae are still not handled well:  the data types
--- will need re-working so that a "Formula lb" type constructor can be
--- introduced having the correct (* -> *) kind to be a Functor.
---
--- Revision 1.13  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.12  2003/05/30 15:04:56  graham
--- Fix references to defunct GraphHelpers module
---
--- Revision 1.11  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.10  2003/05/23 16:29:20  graham
--- Partial code cleanup:
--- - Arc is an alebraic type
--- - Arc is an instance of Functor
--- - add gmap function to Graph interface
--- - remove some duplicate functions from GraphMatch
--- This in preparation for adding graph merge facility with
--- blank node renaming.
---
--- Revision 1.9  2003/05/14 02:01:59  graham
--- GraphMatch recoded and almost working, but
--- there are a couple of
--- obscure bugs that are proving rather stubborn to squash.
---
--- Revision 1.8  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.7  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.6  2003/04/11 18:04:49  graham
--- Rename GraphLookupMap to LookupMap:
--- GraphTest runs OK.
---
--- Revision 1.5  2003/04/10 13:41:22  graham
--- More graph code tidying
--- Graph test cases still run OK
---
--- Revision 1.4  2003/04/10 13:35:34  graham
--- Separated GraphMatch logic from GraphMem
---
--- Revision 1.3  2003/04/10 08:36:06  graham
--- Graph matching passes battery of new tests
--- Started work on RDF graph
---
--- Revision 1.2  2003/03/31 20:52:23  graham
--- Restructure graph matching to deal with same unbound node names in
--- different graphs.  It shows signs that it might be working now.
--- More testing is needed.
---
--- Revision 1.1  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
− Swish/HaskellRDF/GraphPartition.hs 
@@ -1,560 +0,0 @@---------------------------------------------------------------------------------
---  $Id: GraphPartition.hs,v 1.3 2004/02/11 14:19:36 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphPartition
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains functions for partitioning a graph into subgraphs
---  that rooted from different subject nodes.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.GraphPartition
-    ( PartitionedGraph(..), getArcs, getPartitions
-    , GraphPartition(..), node, toArcs
-    , partitionGraph, comparePartitions
-    , partitionShowP
-    )
-where
-
-import Swish.HaskellRDF.GraphClass
-    ( Label(..)
-    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
-    -- , hasLabel, arcLabels
-    )
-
-import Data.List
-    ( partition )
-
-import Control.Monad.State
-    ( MonadState(..), State(..), evalState )
-
-import Data.Maybe
-    ( isJust, fromJust, catMaybes, listToMaybe )
-
-
-------------------------------------------------------------
---  Data type for a partitioned graph
-------------------------------------------------------------
-
--- |Representation of a graph as a collection of (possibly nested)
---  partitions.  Each node in the graph appears at least once as the
---  root value of a GraphPartition value:
---
---  * Nodes that are the subject of at least one statement appear as
---    the first value of exactly one PartSub constructor, and may
---    also appear in any number of PartObj constructors.
---
---  * Nodes appearing only as objects of statements appear only in
---    PartObj constructors.
-
-data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]
-    deriving (Eq,Show)
-
-getArcs :: PartitionedGraph lb -> [Arc lb]
-getArcs (PartitionedGraph ps) = concatMap toArcs ps
-
-getPartitions :: PartitionedGraph lb -> [GraphPartition lb]
-getPartitions (PartitionedGraph ps) = ps
-
-data GraphPartition lb
-    = PartObj lb
-    | PartSub lb [(lb,GraphPartition lb)]
-
-node :: GraphPartition lb -> lb
-node (PartObj ob)   = ob
-node (PartSub sb _) = sb
-
-toArcs :: GraphPartition lb -> [Arc lb]
-toArcs (PartObj _)      = []
-toArcs (PartSub sb prs) = concat $ map toArcs1 prs
-    where
-        toArcs1 (pr,ob) = (Arc sb pr (node ob)):toArcs ob
-
-instance (Label lb) => Eq (GraphPartition lb) where
-    (==) = partitionEq
-
-instance (Label lb) => Show (GraphPartition lb) where
-    show = partitionShow
-
---  Equality is based on total structural equivalence.
---  This is not the same as graph equality.
-partitionEq :: (Label lb) => (GraphPartition lb) -> (GraphPartition lb) -> Bool
-partitionEq (PartObj o1)    (PartObj o2)    = o1 == o2
-partitionEq (PartSub s1 p1) (PartSub s2 p2) = (s1 == s2) && (p1==p2)
-partitionEq  _               _              = False
-
-partitionShow :: (Label lb) => (GraphPartition lb) -> String
-partitionShow (PartObj ob)          = show ob
-partitionShow (PartSub sb (pr:prs)) =
-    "("++ show sb ++ " " ++ showpr pr ++ concatMap ((" ; "++).showpr) prs ++ ")"
-    where
-        showpr (pr,ob) = show pr ++ " " ++ show ob
-
-partitionShowP :: (Label lb) => String -> (GraphPartition lb) -> String
-partitionShowP pref (PartObj ob)          = show ob
-partitionShowP pref (PartSub sb (pr:prs)) =
-    pref++"("++ show sb ++ " " ++ showpr pr ++ concatMap (((pref++"  ; ")++).showpr) prs ++ ")"
-    where
-        showpr (pr,ob) = show pr ++ " " ++ partitionShowP (pref++"  ") ob
-
-------------------------------------------------------------
---  Creating partitioned graphs
-------------------------------------------------------------
---
--- |Turning a partitioned graph into a flat graph is easy.
---  The interesting challenge is to turn a flat graph into a
---  partitioned graph that is more useful for certain purposes.
---  Currently, I'm interested in:
---  (a) isolating differences between graphs
---  (b) pretty-printing graphs
---
---  For (a), the goal is to separate subgraphs that are known
---  to be equivalent from subgraphs that are known to be different,
---  such that (i) different sub-graphs are minimized, (ii) different
---  sub-graphs are placed into 1:1 correspondence (possibly with null
---  subgraphs), and (iii) only deterministic matching decisions are made.
---
---  For (b), the goal is to decide when a subgraph is to be treated
---  as nested in another partition, or treated as a new top-level partition.
---  If a subgraph is referenced by exactly one graph partition, it should
---  be nested in that partition, otherwise it should be a new top-level
---  partition.
---
---  Strategy.  Examining just subject and object nodes:
---  1. all non-blank subject nodes are the root of a top-level partition
---  2. blank subject nodes that are not the object of exactly one statement
---     are the root of a top-level partition.
---  3. blank nodes referenced as the object of exactly 1 statement
---     of an existing partition are the root of a sub-partition of the
---     refering partition.
---  4. what remain are circular chains of blank nodes not referenced
---     elsewhere:  for each such chain, pick a root node arbitrarily.
---
-partitionGraph :: (Label lb) => [Arc lb] -> PartitionedGraph lb
-partitionGraph arcs =
-    makePartitions fixs topv1 intv1
-    where
-        (fixs,vars)  = partition isNonVar $ collect arcSubj arcs
-        vars1        = collectMore arcObj arcs vars
-        (intv,topv)  = partition objOnce vars1
-        intv1        = map stripObj intv
-        topv1        = map stripObj topv
-        isNonVar     = not . labelIsVar . fst
-        objOnce      = isSingle . snd . snd
-        isSingle [_] = True
-        isSingle _   = False
-        stripObj (k,(s,_)) = (k,s)
-
--- Local state type for partitioning function
-type MakePartitionState lb = ([(lb,[Arc lb])],[(lb,[Arc lb])],[(lb,[Arc lb])])
-
-makePartitions :: (Eq lb) =>
-    [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> PartitionedGraph lb
-makePartitions fixs topv intv =
-    PartitionedGraph $ evalState (makePartitions1 []) (fixs,topv,intv)
-
--- Use a state monad to keep track of arcs that have been incorporated into
--- the resulting list of graph partitions.  The collections of arcs used to
--- generate the list of partitions are supplied as theinitial state of the
--- monad (see call of evalState above).
---
-makePartitions1 :: (Eq lb) =>
-    [(lb,[Arc lb])] -> State (MakePartitionState lb) [GraphPartition lb]
-makePartitions1 [] =
-    do  { s <- pickNextSubject
-        ; if null s then return [] else makePartitions1 s
-        }
-makePartitions1 (sub:subs) =
-    do  { ph <- makePartitions2 sub
-        ; pt <- makePartitions1 subs
-        ; return $ ph++pt
-        }
-
-makePartitions2 :: (Eq lb) =>
-    (lb,[Arc lb]) -> State (MakePartitionState lb) [GraphPartition lb]
-makePartitions2 subs =
-    do  { (part,moresubs) <- makeStatements subs
-        ; moreparts <- if (not $ null moresubs) then
-            makePartitions1 moresubs
-          else
-            return []
-        ; return $ part:moreparts
-        }
-
-makeStatements :: (Eq lb) =>
-    (lb,[Arc lb])
-    -> State (MakePartitionState lb) (GraphPartition lb,[(lb,[Arc lb])])
-makeStatements (sub,stmts) =
-    do  { propmore <- sequence (map makeStatement stmts)
-        ; let (props,moresubs) = unzip propmore
-        ; return (PartSub sub props,concat moresubs)
-        }
-
-makeStatement :: (Eq lb) =>
-    Arc lb
-    -> State (MakePartitionState lb) ((lb,GraphPartition lb),[(lb,[Arc lb])])
-makeStatement (Arc sub prop obj) =
-    do  { intobj <- pickIntSubject obj
-        ; (gpobj,moresubs) <- if null intobj
-          then
-            do  { ms <- pickVarSubject obj
-                ; return (PartObj obj,ms)
-                }
-          else
-            makeStatements (head intobj)
-        ; return ((prop,gpobj),moresubs)
-        }
-
-pickNextSubject :: State (MakePartitionState lb) [(lb,[Arc lb])]
-pickNextSubject =
-    do  { (s1,s2,s3) <- get
-        ; let (s,st) = case (s1,s2,s3) of
-                (s1h:s1t,s2,s3) -> ([s1h],(s1t,s2,s3))
-                ([],s2h:s2t,s3) -> ([s2h],([],s2t,s3))
-                ([],[],s3h:s3t) -> ([s3h],([],[],s3t))
-                ([],[],[])      -> ([]   ,([],[],[] ))
-        ; put st
-        ; return s
-        }
-
-pickIntSubject :: (Eq lb) =>
-    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]
-pickIntSubject sub =
-    do  { (s1,s2,s3) <- get
-        ; let varsub = removeBy (\x->(x==).fst) sub s3
-        ; if (isJust varsub) then
-            do  { let (vs,s3new) = fromJust varsub
-                ; put (s1,s2,s3new)
-                ; return [vs]
-                }
-          else
-            return []
-        }
-
-pickVarSubject :: (Eq lb) =>
-    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]
-pickVarSubject sub =
-    do  { (s1,s2,s3) <- get
-        ; let varsub = removeBy (\x->(x==).fst) sub s2
-        ; if (isJust varsub) then
-            do  { let (vs,s2new) = fromJust varsub
-                ; put (s1,s2new,s3)
-                ; return [vs]
-                }
-          else
-            return []
-        }
-
-------------------------------------------------------------
---  Other useful functions
-------------------------------------------------------------
---
---  Create a list of pairs of corresponding Partitions that
---  are unequal
-
-comparePartitions :: (Label lb) =>
-    PartitionedGraph lb -> PartitionedGraph lb
-    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-comparePartitions (PartitionedGraph gp1) (PartitionedGraph gp2) =
-    comparePartitions1 (reverse gp1) (reverse gp2)
-
-comparePartitions1 :: (Label lb) =>
-    [GraphPartition lb] -> [GraphPartition lb]
-    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-comparePartitions1 pg1 pg2 =
-        ds ++ [ (Just r1p,Nothing) | r1p<-r1 ]
-           ++ [ (Nothing,Just r2p) | r2p<-r2 ]
-    where
-        (ds,r1,r2) = listDifferences comparePartitions2 pg1 pg2
-
---  Compare two graph partitions, with three possible outcomes:
---    Nothing    -> no match
---    Just []    -> total match
---    Just [...] -> partial match, with mismatched sub-partitions listed.
---
---  A partial match occurs when the leading nodes are non-variable and
---  equal, but something else in the partition does not match.
---
---  A complete match can be achieved with variable nodes that have
---  different labels
---
-comparePartitions2 :: (Label lb) =>
-    GraphPartition lb -> GraphPartition lb
-    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-comparePartitions2 (PartObj l1) (PartObj l2) =
-    if matchNodes l1 l2 then Just [] else Nothing
-comparePartitions2 pg1@(PartSub l1 p1s) pg2@(PartSub l2 p2s) =
-    if match then comp1 else Nothing
-    where
-        comp1  = case comparePartitions3 l1 l2 p1s p2s of
-                    Nothing -> if matchVar then Nothing
-                                           else Just [(Just pg1,Just pg2)]
-                    Just [] -> Just []
-                    Just ps -> {- if matchVar then Nothing else -} Just ps
-        matchVar = labelIsVar l1 && labelIsVar l2
-        match    = matchVar || (l1 == l2)
-comparePartitions2 pg1 pg2 =
-    if not (labelIsVar l1) && (l1==l2)
-        then Just [(Just pg1,Just pg2)]
-        else Nothing
-    where
-        l1 = node pg1
-        l2 = node pg2
-
-comparePartitions3 :: (Label lb) =>
-    lb -> lb -> [(lb,GraphPartition lb)] -> [(lb,GraphPartition lb)]
-    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-comparePartitions3 l1 l2 s1s s2s = Just $
-        ds ++ [ (Just (PartSub l1 [r1p]),Nothing) | r1p<-r1 ]
-           ++ [ (Nothing,Just (PartSub l2 [r2p])) | r2p<-r2 ]
-    where
-        (ds,r1,r2) = listDifferences (comparePartitions4 l1 l2) s1s s2s
-
-comparePartitions4 :: (Label lb) =>
-    lb -> lb -> (lb,GraphPartition lb) -> (lb,GraphPartition lb)
-    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-comparePartitions4 s1 s2 po1@(p1,o1) po2@(p2,o2) =
-    if matchNodes p1 p2 then comp1 else Nothing
-    where
-        comp1   = case comparePartitions2 o1 o2 of
-                    Nothing -> Just [((Just o1),(Just o2))]
-                    ds      -> ds
-        -- nomatch = (Just (PartSub s1 [po1]),Just (PartSub s2 [po2]))
-
-matchNodes :: (Label lb) => lb -> lb -> Bool
-matchNodes l1 l2
-    | labelIsVar l1 = labelIsVar l2
-    | otherwise     = l1 == l2
-
-
-------------------------------------------------------------
---  Helpers
-------------------------------------------------------------
-
--- |Collect a list of items by some comparison of a selected component
---  or other derived value.
---
---  cmp     a comparison function that determines if a pair of values
---          should be grouped together
---  sel     a function that selects a value from any item
---
---  Example:    collect fst [(1,'a'),(2,'b'),(1,'c')] =
---                  [(1,[(1,'a'),(1,'c')]),(2,[(2,'b')])]
---
-collect :: (Eq b) => (a->b) -> [a] -> [(b,[a])]
-collect = collectBy (==)
-
-collectBy :: (b->b->Bool) -> (a->b) -> [a] -> [(b,[a])]
-collectBy cmp sel = map reverseCollection . collectBy1 cmp sel []
-
-collectBy1 :: (b->b->Bool) -> (a->b) -> [(b,[a])] -> [a] -> [(b,[a])]
-collectBy1 cmp sel sofar []     = sofar
-collectBy1 cmp sel sofar (a:as) =
-    collectBy1 cmp sel (collectBy2 cmp sel a sofar) as
-
-collectBy2 :: (b->b->Bool) -> (a->b) -> a -> [(b,[a])] -> [(b,[a])]
-collectBy2 cmp sel a [] = [(sel a,[a])]
-collectBy2 cmp sel a (col@(k,as):cols)
-    | cmp ka k  = (k,a:as):cols
-    | otherwise = col:collectBy2 cmp sel a cols
-    where
-        ka = sel a
-
-reverseCollection :: (b,[a]) -> (b,[a])
-reverseCollection (k,as) = (k,reverse as)
-
--- Example/test:
-testCollect1 = collect fst [(1,'a'),(2,'b'),(1,'c'),(1,'d'),(2,'d'),(3,'d')]
-testCollect2 = testCollect1
-                == [ (1,[(1,'a'),(1,'c'),(1,'d')])
-                   , (2,[(2,'b'),(2,'d')])
-                   , (3,[(3,'d')])
-                   ]
-
--- |Add new values to an existing list of collections.
---  The list of collections is not extended, but each collection is
---  augmented with a further list of values from the supplied list,
---  each of which are related to the existing collection in some way.
---
---  [[[NOTE: the basic pattern of collect and collectMore is similar,
---  and might be generalized into a common set of core functions.]]]
---
-collectMore :: (Eq b) => (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
-collectMore = collectMoreBy (==)
-
-collectMoreBy ::
-    (b->b->Bool) -> (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
-collectMoreBy cmp sel as cols =
-    map reverseMoreCollection $
-    collectMoreBy1 cmp sel as (map (\ (b,cs) -> (b,(cs,[])) ) cols)
-
-collectMoreBy1 ::
-    (b->b->Bool) -> (a->b) -> [a] -> [(b,(c,[a]))] -> [(b,(c,[a]))]
-collectMoreBy1 cmp sel []     cols = cols
-collectMoreBy1 cmp sel (a:as) cols =
-    collectMoreBy1 cmp sel as (collectMoreBy2 cmp sel a cols)
-
-collectMoreBy2 ::
-    (b->b->Bool) -> (a->b) -> a -> [(b,(c,[a]))] -> [(b,(c,[a]))]
-collectMoreBy2 cmp sel a [] = []
-collectMoreBy2 cmp sel a (col@(k,(b,as)):cols)
-    | cmp (sel a) k = (k,(b,a:as)):cols
-    | otherwise     = col:collectMoreBy2 cmp sel a cols
-
-reverseMoreCollection :: (b,(c,[a])) -> (b,(c,[a]))
-reverseMoreCollection (k,(c,as)) = (k,(c,reverse as))
-
--- Example/test:
-testCollectMore1 =
-    collectMore snd [(111,1),(112,1),(211,2),(311,3),(411,4)] testCollect1
-testCollectMore2 = testCollectMore1
-                == [ (1,([(1,'a'),(1,'c'),(1,'d')],[(111,1),(112,1)]))
-                   , (2,([(2,'b'),(2,'d')],[(211,2)]))
-                   , (3,([(3,'d')],[(311,3)]))
-                   ]
-
--- |Remove supplied element from a list using the supplied test
---  function, and return Just the element remoived and the
---  remaining list, or Nothing if no element was matched for removal.
---
-remove :: (Eq a) => a -> [a] -> Maybe (a,[a])
-remove = removeBy (==)
-
-removeBy :: (b->a->Bool) -> b -> [a] -> Maybe (a,[a])
-removeBy cmp a0 as = removeBy1 cmp a0 as []
-
-removeBy1 :: (b->a->Bool) -> b -> [a] -> [a] -> Maybe (a,[a])
-removeBy1 _   _  []     _     = Nothing
-removeBy1 cmp a0 (a:as) sofar
-    | cmp a0 a  = Just (a,reverseTo sofar as)
-    | otherwise = removeBy1 cmp a0 as (a:sofar)
-
-testRemove1  = remove 3 [1,2,3,4,5]
-testRemove2  = testRemove1 == Just (3,[1,2,4,5])
-testRemove3  = remove 3 [1,2,4,5]
-testRemove4  = testRemove3 == Nothing
-testRemove5  = remove 5 [1,2,4,5]
-testRemove6  = testRemove5 == Just (5,[1,2,4])
-testRemove7  = remove 1 [1,2,4]
-testRemove8  = testRemove7 == Just (1,[2,4])
-testRemove9  = remove 2 [2]
-testRemove10 = testRemove9 == Just (2,[])
-
--- |Reverse first argument, prepending the result to the second argument
---
-reverseTo :: [a] -> [a] -> [a]
-reverseTo []        back = back
-reverseTo (a:front) back = reverseTo front (a:back)
-
--- |Remove each element from a list, returning a list of pairs,
---  each of which is the element removed and the list remaining.
---
-removeEach :: [a] -> [(a,[a])]
-removeEach [] = []
-removeEach (a:as) = (a,as):[ (a1,a:a1s) | (a1,a1s) <- removeEach as ]
-
-testRemoveEach1 = removeEach [1,2,3,4,5]
-testRemoveEach2 = testRemoveEach1 ==
-    [ (1,[2,3,4,5])
-    , (2,[1,3,4,5])
-    , (3,[1,2,4,5])
-    , (4,[1,2,3,5])
-    , (5,[1,2,3,4])
-    ]
-
--- |List differences between the members of two lists, where corresponding
---  elements may appear at arbitrary locations in the corresponding lists.
---
---  Elements are compared using the function 'cmp', which returns:
---  * Nothing  if the elements are completely unrelated
---  * Just []  if the elements are identical
---  * Just ds  if the elements are related but not identical, in which case
---             ds is a list of values describing differences between them.
---
---  Returns (ds,u1,u2), where:
---  ds is null if the related elements from each list are identical,
---  otherwise is a list of differences between the related elements.
---  u1 is a list of elements in a1 not related to elements in a2.
---  u2 is a list of elements in a2 not related to elements in a1.
---
-listDifferences :: (a->a->Maybe [d]) -> [a] -> [a] -> ([d],[a],[a])
-listDifferences cmp []       a2s = ([],[],a2s)
-listDifferences cmp (a1:a1t) a2s =
-    case mcomp of
-        Nothing       -> morediffs [] [a1] a1t a2s
-        Just (ds,a2t) -> morediffs ds []   a1t a2t
-    where
-        -- mcomp finds identical match, if there is one, or
-        -- the first element in a2s related to a1, or Nothing
-        -- [choose was listToMaybe,
-        --  but that didn't handle repeated properties well]
-        mcomp = choose $ catMaybes $ map maybeResult comps
-        comps = [ (cmp a1 a2,a2t) | (a2,a2t) <- removeEach a2s ]
-        maybeResult (Nothing,_)   = Nothing
-        maybeResult (Just ds,a2t) = Just (ds,a2t)
-        morediffs ds a1h a1t a2t  = (ds++ds1,a1h++a1r,a2r)
-            where
-                (ds1,a1r,a2r) = listDifferences cmp a1t a2t
-        choose  []       = Nothing
-        choose  ds@(d:_) = choose1 d ds
-        choose1 _ (d@([],dr):_) = Just d
-        choose1 d []            = Just d
-        choose1 d (_:ds)        = choose1 d ds
-
-testcmp (l1,h1) (l2,h2)
-    | (l1 >= h2) || (l2 >= h1) = Nothing
-    | (l1 == l2) && (h1 == h2) = Just []
-    | otherwise                = Just [((l1,h1),(l2,h2))]
-
-testdiff1 = listDifferences testcmp
-                [(12,15),(1,2),(3,4),(5,8),(10,11)]
-                [(10,11),(0,1),(3,4),(6,9),(13,15)]
-testdiff2 = testdiff1 == ([((12,15),(13,15)),((5,8),(6,9))],[(1,2)],[(0,1)])
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphPartition.hs,v $
--- $Author: graham $
--- $Revision: 1.3 $
--- $Log: GraphPartition.hs,v $
--- Revision 1.3  2004/02/11 14:19:36  graham
--- Add graph-difference option to Swish
---
--- Revision 1.2  2004/02/10 20:24:48  graham
--- Graph difference code now works.
---
--- Revision 1.1  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
− Swish/HaskellRDF/GraphPartitionTest.hs 
@@ -1,527 +0,0 @@---------------------------------------------------------------------------------
---  $Id: GraphPartitionTest.hs,v 1.2 2004/02/10 20:24:48 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphPartitionTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for graph partitioning logic.
---
---------------------------------------------------------------------------------
-
---module Swish.HaskellRDF.GraphPartitionTest where
--- module Main(main) where -- WNH--
-import Swish.HaskellRDF.GraphPartition
-    ( PartitionedGraph(..), getArcs
-    , GraphPartition(..), node, toArcs
-    , partitionGraph, comparePartitions
-    )
-
-import Swish.HaskellRDF.GraphClass
-    ( Label(..)
-    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
-    -- , hasLabel, arcLabels
-    )
-
-import Swish.HaskellRDF.GraphMem
-    -- ( GraphMem(..)
-    -- , setArcs, getArcs, add, delete, extract, labels
-    ( LabelMem(..)
-    , labelIsVar, labelHash
-    )
-
-import Swish.HaskellUtils.TestHelpers
-    ( test, testEq, 
-    --     WNH FIX testNe, 
-    testLe, testGe, testElem
-    , testJust, testNothing
-    , testEqv, 
-    --   WNH FIXtestNotEqv, 
-    testEqv2, testHasEqv, testMaybeEqv
-    )
--import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , Assertion
-    , assertBool, assertEqual, assertString, assertFailure
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Control.Monad
-    ( unless )
-
-import Data.List
-    ( sort, union, intersect )
-
-import Data.Maybe
-    ( isJust, fromJust, fromMaybe )
-
-------------------------------------------------------------
---  Basic GraphPartition tests
-------------------------------------------------------------
-
-gp1 = PartitionedGraph [ p11 ]
-gp2 = PartitionedGraph [ p11, p12 ]
-gp3 = PartitionedGraph [ p11, p13 ]
-gp4 = PartitionedGraph [ p11, p14 ]
-gp5 = PartitionedGraph [ p11, p12, p15 ]
-
-p11 = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]
-p12 = PartSub (LF "s2") [ (LF "p21",PartObj (LF "o21"))
-                        , (LF "p22",PartObj (LF "o22"))
-                        ]
-p13 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
-                        , (LF "p32",p12)
-                        , (LF "p33",PartObj (LF "s3"))
-                        ]
-p14 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
-                        , (LF "p33",PartObj (LF "s3"))
-                        , (LF "p32",p12)
-                        ]
-p15 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
-                        , (LF "p32",PartObj (LF "s2"))
-                        , (LF "p33",PartObj (LF "s3"))
-                        ]
-
-ga1 =
-    [ Arc (LF "s1") (LF "p11") (LF "o11")
-    ]
-
-ga2 =
-    [ Arc (LF "s1") (LF "p11") (LF "o11")
-    , Arc (LF "s2") (LF "p21") (LF "o21")
-    , Arc (LF "s2") (LF "p22") (LF "o22")
-    ]
-
-ga3 =
-    [ Arc (LF "s1") (LF "p11") (LF "o11")
-    , Arc (LF "s3") (LF "p31") (LF "o31")
-    , Arc (LF "s3") (LF "p32") (LF "s2")
-    , Arc (LF "s2") (LF "p21") (LF "o21")
-    , Arc (LF "s2") (LF "p22") (LF "o22")
-    , Arc (LF "s3") (LF "p33") (LF "s3")
-    ]
-ga4 =
-    [ Arc (LF "s1") (LF "p11") (LF "o11")
-    , Arc (LF "s3") (LF "p31") (LF "o31")
-    , Arc (LF "s3") (LF "p33") (LF "s3")
-    , Arc (LF "s3") (LF "p32") (LF "s2")
-    , Arc (LF "s2") (LF "p21") (LF "o21")
-    , Arc (LF "s2") (LF "p22") (LF "o22")
-    ]
-ga5 =
-    [ Arc (LF "s1") (LF "p11") (LF "o11")
-    , Arc (LF "s2") (LF "p21") (LF "o21")
-    , Arc (LF "s2") (LF "p22") (LF "o22")
-    , Arc (LF "s3") (LF "p31") (LF "o31")
-    , Arc (LF "s3") (LF "p32") (LF "s2")
-    , Arc (LF "s3") (LF "p33") (LF "s3")
-    ]
-
-testBasic01 = testEq "testBasic01" gp1 gp1
-testBasic02 = testEq "testBasic02" gp2 gp2
-testBasic03 = testEq "testBasic03" gp3 gp3
-testBasic04 = testEq "testBasic04" gp4 gp4
-testBasic05 = testEq "testBasic05" gp5 gp5
-{-     WNH FIX 
-testBasic06 = testNe "testBasic06" gp2 gp3
-testBasic07 = testNe "testBasic07" gp3 gp4
--}
-
-testBasic11 = testEq "testBasic11"
-        "PartitionedGraph [(!s1 !p11 !o11)]"
-        (show gp1)
-testBasic12 = testEq "testBasic12"
-        ( "PartitionedGraph "++
-          "[(!s1 !p11 !o11)"++
-          ",(!s2 !p21 !o21 ; !p22 !o22)"++
-          "]"
-        )
-        (show gp2)
-testBasic13 = testEq "testBasic13"
-        ( "PartitionedGraph "++
-          "[(!s1 !p11 !o11)"++
-          ",(!s3 !p31 !o31 ; !p32 (!s2 !p21 !o21 ; !p22 !o22) ; !p33 !s3)"++
-          "]"
-        )
-        (show gp3)
-testBasic14 = testEq "testBasic14"
-        ( "PartitionedGraph "++
-          "[(!s1 !p11 !o11)"++
-          ",(!s3 !p31 !o31 ; !p33 !s3 ; !p32 (!s2 !p21 !o21 ; !p22 !o22))"++
-          "]"
-        )
-        (show gp4)
-testBasic15 = testEq "testBasic15"
-        ( "PartitionedGraph "++
-          "[(!s1 !p11 !o11)"++
-          ",(!s2 !p21 !o21 ; !p22 !o22)"++
-          ",(!s3 !p31 !o31 ; !p32 !s2 ; !p33 !s3)"++
-          "]"
-        )
-        (show gp5)
-
-testBasic21 = testEq "testBasic21" (LF "s1") (node p11)
-testBasic22 = testEq "testBasic22" (LF "s2") (node p12)
-testBasic23 = testEq "testBasic23" (LF "s3") (node p13)
-testBasic24 = testEq "testBasic24" (LF "s3") (node p14)
-testBasic25 = testEq "testBasic25" (LF "s3") (node p15)
-
-testBasic31 = testEq "testBasic31" ga1 (getArcs gp1)
-testBasic32 = testEq "testBasic32" ga2 (getArcs gp2)
-testBasic33 = testEq "testBasic33" ga3 (getArcs gp3)
-testBasic34 = testEq "testBasic34" ga4 (getArcs gp4)
-testBasic35 = testEq "testBasic35" ga5 (getArcs gp5)
---     WNH FIX testBasic36 = testNotEqv "testBasic36" (getArcs gp2) (getArcs gp3)
-testBasic37 = testEqv    "testBasic37" (getArcs gp3) (getArcs gp4)
-testBasic38 = testEqv    "testBasic38" (getArcs gp3) (getArcs gp5)
-
-testBasicSuite = TestList
-    [ testBasic01
-    , testBasic02
-    , testBasic03
-    , testBasic04
-    , testBasic05
-    --   WNH FIX, testBasic06
-    --   WNH FIX, testBasic07
-    , testBasic11
-    , testBasic12
-    , testBasic13
-    , testBasic14
-    , testBasic15
-    , testBasic21
-    , testBasic22
-    , testBasic23
-    , testBasic24
-    , testBasic25
-    , testBasic31
-    , testBasic32
-    , testBasic33
-    , testBasic34
-    , testBasic35
-    -- WNH FIX, testBasic36
-    , testBasic37
-    , testBasic38
-    ]
-
-------------------------------------------------------------
---  Creating GraphPartition tests
-------------------------------------------------------------
-
-pa1 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    ]
-
-pa2 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    , Arc (LF "s2") (LF "p1") (LF "o21")
-    , Arc (LF "s2") (LF "p2") (LF "o22")
-    ]
-
-pa3 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    , Arc (LF "s2") (LF "p1") (LF "o21")
-    , Arc (LF "s2") (LF "p2") (LF "o22")
-    , Arc (LV "b3") (LF "p") (LF "o31")
-    , Arc (LV "b3") (LF "p") (LF "s2")
-    , Arc (LV "b3") (LF "p") (LV "b3")
-    ]
-
-pa4 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    , Arc (LF "s2") (LF "p1") (LF "o21")
-    , Arc (LF "s2") (LF "p2") (LF "o22")
-    , Arc (LV "b3") (LF "p") (LF "o31")
-    , Arc (LV "b3") (LF "p") (LF "s2")
-    , Arc (LV "b3") (LF "p") (LV "b3")
-    , Arc (LV "b3") (LF "p") (LV "b4")
-    , Arc (LV "b4") (LF "p") (LF "s2")
-    , Arc (LV "b4") (LF "p") (LV "b3")
-    ]
-
-pa5 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    , Arc (LF "s2") (LF "p1") (LF "o21")
-    , Arc (LF "s2") (LF "p2") (LF "o22")
-    , Arc (LV "b3") (LF "p") (LF "o31")
-    , Arc (LV "b3") (LF "p") (LF "s2")
-    , Arc (LV "b3") (LF "p") (LV "b3")
-    , Arc (LV "b3") (LF "p") (LV "b4")
-    , Arc (LV "b4") (LF "p") (LF "s2")
-    , Arc (LV "b4") (LF "p") (LV "b3")
-    , Arc (LV "b5a") (LF "p") (LV "b5b")
-    , Arc (LV "b5b") (LF "p") (LV "b5c")
-    , Arc (LV "b5c") (LF "p") (LV "b5a")
-    ]
-
-pa6 =
-    [ Arc (LF "s1") (LF "p") (LF "o11")
-    , Arc (LF "s2") (LF "p1") (LF "o21")
-    , Arc (LF "s2") (LF "p2") (LF "o22")
-    , Arc (LV "b3") (LF "p") (LF "o31")
-    , Arc (LV "b3") (LF "p") (LF "s2")
-    , Arc (LV "b3") (LF "p") (LV "b3")
-    , Arc (LV "b3") (LF "p") (LV "b4")
-    , Arc (LV "b4") (LF "p") (LF "s2")
-    , Arc (LV "b4") (LF "p") (LV "b3")
-    , Arc (LV "b4") (LF "p") (LV "b5b")
-    , Arc (LV "b5a") (LF "p") (LV "b5b")
-    , Arc (LV "b5b") (LF "p") (LV "b5c")
-    , Arc (LV "b5c") (LF "p") (LV "b5a")
-    ]
-
-pp1  = PartitionedGraph [ ps1 ]
-pp2f = PartitionedGraph [ ps1,  ps2f ]
-pp2r = PartitionedGraph [ ps2r, ps1 ]
-pp3f = PartitionedGraph [ ps1,  ps2f, pb3f ]
-pp3r = PartitionedGraph [ ps2r, ps1,  pb3r ]
-pp4f = PartitionedGraph [ ps1,  ps2f, pb3af ]
-pp4r = PartitionedGraph [ ps2r, ps1,  pb3ar ]
-pp5f = PartitionedGraph [ ps1,  ps2f, pb3af, pb5a1 ]
-pp5r = PartitionedGraph [ ps2r, ps1,  pb3ar, pb5c3 ]
-pp6f = PartitionedGraph [ ps1,  ps2f, pb3bf, pb5b2 ]
-pp6r = PartitionedGraph [ ps2r, ps1,  pb5b2, pb3br ]
-
-ps1  = PartSub (LF "s1") [ (LF "p",PartObj (LF "o11")) ]
-ps2f = PartSub (LF "s2") [ (LF "p1",PartObj (LF "o21"))
-                         , (LF "p2",PartObj (LF "o22"))
-                         ]
-ps2r = PartSub (LF "s2") [ (LF "p2",PartObj (LF "o22"))
-                         , (LF "p1",PartObj (LF "o21"))
-                         ]
-pb3f = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
-                         , (LF "p",PartObj (LF "s2"))
-                         , (LF "p",PartObj (LV "b3"))
-                         ]
-pb3r = PartSub (LV "b3") [ (LF "p",PartObj (LV "b3"))
-                         , (LF "p",PartObj (LF "s2"))
-                         , (LF "p",PartObj (LF "o31"))
-                         ]
-
-pb3af = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
-                          , (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",pb4af)
-                          ]
-pb3ar = PartSub (LV "b3") [ (LF "p",pb4ar)
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LF "o31"))
-                          ]
-pb4af = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LV "b3"))
-                          ]
-pb4ar = PartSub (LV "b4") [ (LF "p",PartObj (LV "b3"))
-                          , (LF "p",PartObj (LF "s2"))
-                          ]
-pb5a1 = PartSub (LV "b5a") [ (LF "p",pb5b1) ]
-pb5b1 = PartSub (LV "b5b") [ (LF "p",pb5c1) ]
-pb5c1 = PartSub (LV "b5c") [ (LF "p",PartObj (LV "b5a")) ]
-
-pb3bf = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
-                          , (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",pb4bf)
-                          ]
-pb3br = PartSub (LV "b3") [ (LF "p",pb4br)
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LF "o31"))
-                          ]
-pb4bf = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",PartObj (LV "b5b"))
-                          ]
-pb4br = PartSub (LV "b4") [ (LF "p",PartObj (LV "b5b"))
-                          , (LF "p",PartObj (LV "b3"))
-                          , (LF "p",PartObj (LF "s2"))
-                          ]
-pb5a2 = PartSub (LV "b5a") [ (LF "p",PartObj (LV "b5b")) ]
-pb5b2 = PartSub (LV "b5b") [ (LF "p",pb5c2) ]
-pb5c2 = PartSub (LV "b5c") [ (LF "p",pb5a2) ]
-
-pb5a3 = PartSub (LV "b5a") [ (LF "p",pb5b3) ]
-pb5b3 = PartSub (LV "b5b") [ (LF "p",PartObj (LV "b5c")) ]
-pb5c3 = PartSub (LV "b5c") [ (LF "p",pb5a3) ]
-
-testPartition11 = testEq "testPartition11" pp1  (partitionGraph pa1)
-testPartition12 = testEq "testPartition12" pp2f (partitionGraph pa2)
-testPartition13 = testEq "testPartition13" pp3f (partitionGraph pa3)
-testPartition14 = testEq "testPartition15" pp4f (partitionGraph pa4)
-testPartition15 = testEq "testPartition14" pp5f (partitionGraph pa5)
-testPartition16 = testEq "testPartition16" pp6f (partitionGraph pa6)
-
-testPartition21 = testEq "testPartition21" pp1  (partitionGraph $ reverse pa1)
-testPartition22 = testEq "testPartition22" pp2r (partitionGraph $ reverse pa2)
-testPartition23 = testEq "testPartition23" pp3r (partitionGraph $ reverse pa3)
-testPartition24 = testEq "testPartition24" pp4r (partitionGraph $ reverse pa4)
-testPartition25 = testEq "testPartition25" pp5r (partitionGraph $ reverse pa5)
-testPartition26 = testEq "testPartition26" pp6r (partitionGraph $ reverse pa6)
-
-testPartition31 = testEqv "testPartition31" pa1  (getArcs pp1)
-testPartition32 = testEqv "testPartition32" pa2  (getArcs pp2f)
-testPartition33 = testEqv "testPartition33" pa3  (getArcs pp3f)
-testPartition34 = testEqv "testPartition35" pa4  (getArcs pp4f)
-testPartition35 = testEqv "testPartition34" pa5  (getArcs pp5f)
-testPartition36 = testEqv "testPartition36" pa6  (getArcs pp6f)
-
-testPartition41 = testEqv "testPartition41" pa1  (getArcs pp1 )
-testPartition42 = testEqv "testPartition42" pa2  (getArcs pp2r)
-testPartition43 = testEqv "testPartition43" pa3  (getArcs pp3r)
-testPartition44 = testEqv "testPartition44" pa4  (getArcs pp4r)
-testPartition45 = testEqv "testPartition45" pa5  (getArcs pp5r)
-testPartition46 = testEqv "testPartition46" pa6  (getArcs pp6r)
-
-testPartition51 = testEqv "testPartition51" []   (comparePartitions pp1  pp1)
-testPartition52 = testEqv "testPartition52" []   (comparePartitions pp2f pp2r)
-testPartition53 = testEqv "testPartition53" []   (comparePartitions pp3f pp3r)
-testPartition54 = testEqv "testPartition54" []   (comparePartitions pp4f pp4r)
-testPartition55 = testEqv "testPartition55" []   (comparePartitions pp5f pp5r)
-testPartition56 = testEqv "testPartition56" []   (comparePartitions pp6f pp6r)
-testPartition57 = testEqv "testPartition57"
-        [(Nothing,Just $ PartSub (LV "b3") [(LF "p",pb4af)])]
-        (comparePartitions pp3f pp4f)
-testPartition58 = testEqv "testPartition58"
-        [(Nothing,Just pb5a1)]
-        (comparePartitions pp4f pp5f)
-testPartition59 = testEqv "testPartition59"
-        [(Nothing,Just $ PartSub (LV "b4") [(LF "p",PartObj (LV "b5b"))])]
-        (comparePartitions pp5f pp6f)
-
-testPartitionSuite = TestList
-    [ testPartition11
-    , testPartition12
-    , testPartition13
-    , testPartition14
-    , testPartition15
-    , testPartition16
-    , testPartition21
-    , testPartition22
-    , testPartition23
-    , testPartition24
-    , testPartition25
-    , testPartition26
-    , testPartition31
-    , testPartition32
-    , testPartition33
-    , testPartition34
-    , testPartition35
-    , testPartition36
-    , testPartition41
-    , testPartition42
-    , testPartition43
-    , testPartition44
-    , testPartition45
-    , testPartition46
-    , testPartition51
-    , testPartition52
-    , testPartition53
-    , testPartition54
-    , testPartition55
-    , testPartition56
-    , testPartition57
-    , testPartition58
-    , testPartition59
-    ]
-
-
-------------------------------------------------------------
---  GraphPartition compare test with partial matching
-------------------------------------------------------------
-
-pgc1a = PartitionedGraph [ c11, c12a ]
-pgc1b = PartitionedGraph [ c11, c12b ]
-
-c11  = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]
-c12a = PartSub (LF "s2") [ (LF "p21",c13a)
-                         , (LF "p22",PartObj (LF "o22"))
-                         ]
-c12b = PartSub (LF "s2") [ (LF "p22",PartObj (LF "o22"))
-                         , (LF "p21",c13b)
-                         ]
-c13a = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))
-                         , (LF "p33",PartObj (LF "o33a"))
-                         ]
-c13b = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))
-                         , (LF "p33",PartObj (LF "o33b"))
-                         ]
-testCompare01 = testEqv "testCompare01"
-        [(Just (PartObj (LF "o33a")),Just (PartObj (LF "o33b")))]
-        (comparePartitions pgc1a pgc1b)
-
-
-testCompareSuite = TestList
-    [ testCompare01
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-    [ testBasicSuite
-    , testPartitionSuite
-    , testCompareSuite
-    ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphPartitionTest.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: GraphPartitionTest.hs,v $
--- Revision 1.2  2004/02/10 20:24:48  graham
--- Graph difference code now works.
---
--- Revision 1.1  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
− Swish/HaskellRDF/GraphTest.hs 
@@ -1,1730 +0,0 @@---------------------------------------------------------------------------------
---  $Id: GraphTest.hs,v 1.24 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  GraphTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + multi-parameter classes
---
---  This module defines test cases for module Graph.
---
---------------------------------------------------------------------------------
-
-
--- WNH module Swish.HaskellRDF.GraphTest where
-
-import System.IO
-      ( Handle, IOMode(WriteMode),
-        openFile, hClose, hPutStr, hPutStrLn )
-import Test.HUnit
-      ( Test(TestCase,TestList,TestLabel),
-        assertEqual, runTestTT, runTestText, putTextToHandle )
-import Data.List( elemIndex )
-import Data.Maybe( fromJust )
-
-import Swish.HaskellUtils.ListHelpers
-import Swish.HaskellUtils.MiscHelpers
-import Swish.HaskellRDF.GraphClass (Arc(..),Label(..),arcFromTriple,arcToTriple)
-import Swish.HaskellRDF.GraphMem
-import Swish.HaskellRDF.GraphMatch
-      ( graphMatch,
-        -- The rest exported for testing only
-        LabelMap(..), GenLabelMap(..), LabelEntry(..), GenLabelEntry(..),
-        ScopedLabel(..), makeScopedLabel, makeScopedArc,
-        LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
-        labelIsVar, labelHash,
-        mapLabelIndex, {-mapLabelList,-} setLabelHash, newLabelMap,
-        graphLabels, assignLabelMap, newGenerationMap,
-        graphMatch1, graphMatch2, equivalenceClasses, reclassify
-      )
-import Swish.HaskellUtils.LookupMap
-      ( LookupEntryClass(..), LookupMap(..), makeLookupMap
-      , mapSortByKey, mapSortByVal
-      )
-
-default ( Int )
-
-------------------------------------------------------------
--- Define some common values
-------------------------------------------------------------
-
-base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-
-------------------------------------------------------------
---  Set, get graph arcs as lists of triples
-------------------------------------------------------------
-
-setArcsT a = setArcs $ map arcFromTriple a
-getArcsT g = map arcToTriple $ getArcs g
-
-toStatement s p o = Arc s p o
-
-------------------------------------------------------------
---  Test class helper
-------------------------------------------------------------
-
-testeq :: (Show a, Eq a) => String -> a -> a -> Test
-testeq lab req got =
-    TestCase ( assertEqual ("test"++lab) req got )
-
-testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test
-testeqv lab req got =
-    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )
-
-------------------------------------------------------------
---  Label map and entry creation helpers
-------------------------------------------------------------
-
-tstLabelMap :: (Label lb) => Int -> [(lb,LabelIndex)] -> LabelMap lb
-tstLabelMap gen lvs = LabelMap gen (makeLookupMap $ makeEntries lvs)
-
-makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb]
-makeEntries lvs = map newEntry lvs
-
-labelMapSortByVal :: (Label lb) => LabelMap lb -> LabelMap lb
-labelMapSortByVal (LabelMap gen lmap) = LabelMap gen (mapSortByVal lmap)
-
-------------------------------------------------------------
---  Graph helper function tests
-------------------------------------------------------------
-
--- select
-
-testSelect :: String -> [Char] -> [Char] -> Test
-testSelect lab l1 l2 = testeq ("Select"++lab ) l1 l2
-
-testSelect01 = testSelect "01"
-                (select (1==) [0,1,2,0,1,2] ['a','b','c','a','b','c'])
-                ['b','b']
-testSelect02 = testSelect "02"
-                (select (1==) [1,1,1,1,1,1] ['a','b','c','a','b','c'])
-                ['a','b','c','a','b','c']
-testSelect03 = testSelect "03"
-                (select (1==) [0,0,0,0,0,0] ['a','b','c','a','b','c'])
-                []
-testSelect04 = testSelect "04"
-                (select (1==) []            []                       )
-                []
-
-testSelectSuite = TestList
-    [
-    testSelect01, testSelect02, testSelect03, testSelect04
-    ]
-
--- mapset
-
-mf   :: Int -> Char
-mf n = "_abcde" !! n
-
-testMapset :: String -> [Int] -> [Char] -> Test
-testMapset lab l1 l2 = testeq ("Mapset"++lab ) l2 (mapset mf l1)
-
-testMapset01 = testMapset "01" [0,1,2,3,4,5] ['_','a','b','c','d','e']
-testMapset02 = testMapset "02" [1,1,3,3,5,5] ['a','c','e']
-testMapset03 = testMapset "03" [5,4,3,2,1,0] ['e','d','c','b','a','_']
-testMapset04 = testMapset "04" []            []
-testMapset05 = testMapset "05" [1,2,3,4,5,0] ['a','b','c','d','e','_']
-
-testMapsetSuite = TestList
-    [
-    testMapset01, testMapset02, testMapset03, testMapset04,
-    testMapset05
-    ]
-
--- subset
-
-testSubset :: String -> Bool -> [Int] -> [Int] -> Test
-testSubset lab res l1 l2 = testeq ("Mapset"++lab ) res (l1 `subset` l2)
-
-testSubset01 = testSubset "01" True  [1,2,3]       [0,1,2,3,4,5]
-testSubset02 = testSubset "02" True  [5,3,1]       [0,1,2,3,4,5]
-testSubset03 = testSubset "03" True  [5,4,3,2,1,0] [0,1,2,3,4,5]
-testSubset04 = testSubset "04" True  []            []
-testSubset05 = testSubset "05" False [0,1,2,3,4,5] [1,2,3]
-testSubset06 = testSubset "06" False [0,1,2,3,4,5] [5,3,1]
-testSubset07 = testSubset "07" True  []            [1,2,3]
-testSubset08 = testSubset "08" False [1,2,3]       []
-
-testSubsetSuite = TestList
-    [
-    testSubset01, testSubset02, testSubset03, testSubset04,
-    testSubset05, testSubset06, testSubset07, testSubset08
-    ]
-
--- hash
-
-testHash :: String -> Bool -> Int -> Int -> Test
-testHash lab eq h1 h2 = testeq ("Hash"++lab ) eq (h1 == h2)
-testHashEq lab h1 h2  = testeq ("Hash"++lab ) h1 h2
-
-testHash01 = testHash "01" True  (hash 0 base1) (hash 0 base1)
-testHash02 = testHash "02" True  (hash 2 "")    (hash 2 "")
-testHash03 = testHash "03" False (hash 3 base1) (hash 3 base2)
-testHash04 = testHash "04" False (hash 4 base1) (hash 5 base1)
-testHash05 = testHash "05" False (hash 2 "")    (hash 3 "")
-testHash06 = testHashEq "06"     1424775        (hash 3 base1)
-testHash07 = testHashEq "07"     11801303       (hash 3 base2)
-
-testHashSuite = TestList
-    [
-    testHash01, testHash02, testHash03, testHash04,
-    testHash05, testHash06, testHash07
-    ]
-
-------------------------------------------------------------
---  Simple graph label tests
-------------------------------------------------------------
-
-testLab01 = testeq "Lab01" False (labelIsVar lab1f)
-testLab02 = testeq "Lab02" True  (labelIsVar lab1v)
-testLab03 = testeq "Lab03" False (labelIsVar lab2f)
-testLab04 = testeq "Lab04" True  (labelIsVar lab2v)
-
-testLab05 = testeq "Lab05"  3436883 (labelHash 1 lab1f)
-testLab06 = testeq "Lab06" 10955600 (labelHash 1 lab1v)
-testLab07 = testeq "Lab07"  3436884 (labelHash 1 lab2f)
-testLab08 = testeq "Lab08" 10955601 (labelHash 1 lab2v)
-
-testLab09 = testeq "Lab09" "!lab1" (show lab1f)
-testLab10 = testeq "Lab10" "?lab1" (show lab1v)
-testLab11 = testeq "Lab11" "!lab2" (show lab2f)
-testLab12 = testeq "Lab12" "?lab2" (show lab2v)
-
-testLab13 = testeq "Lab13" "lab1" (getLocal lab1v)
-testLab14 = testeq "Lab14" "lab2" (getLocal lab2v)
-testLab15 = testeq "Lab15" lab1v  (makeLabel "lab1")
-testLab16 = testeq "Lab16" lab2v  (makeLabel "lab2")
-
-testLabSuite = TestList
-    [
-    testLab01, testLab02, testLab03, testLab04,
-    testLab05, testLab06, testLab07, testLab08,
-    testLab09, testLab10, testLab11, testLab12,
-    testLab13, testLab14, testLab15, testLab16
-    ]
-
-------------------------------------------------------------
---  Simple graph tests
-------------------------------------------------------------
-
-lab1f = LF "lab1"
-lab1v = LV "lab1"
-lab2f = LF "lab2"
-lab2v = LV "lab2"
-
-gr1 = GraphMem { arcs=[]::[Arc LabelMem] }
-ga1 =
-    [
-    (lab1f,lab1f,lab1f),
-    (lab1v,lab1v,lab1v),
-    (lab2f,lab2f,lab2f),
-    (lab2v,lab2v,lab2v),
-    (lab1f,lab1f,lab1v),
-    (lab1f,lab1f,lab2f),
-    (lab1f,lab1f,lab2v),
-    (lab1v,lab1v,lab1f),
-    (lab1v,lab1v,lab2f),
-    (lab1v,lab1v,lab2v),
-    (lab1f,lab1v,lab2f),
-    (lab1f,lab1v,lab2v),
-    (lab1v,lab2f,lab2v)
-    ]
-
-gs4 (Arc _ _ (LV "lab2")) = True
-gs4 (Arc _ _  _         ) = False
-ga4 =
-    [
-    (lab2v,lab2v,lab2v),
-    (lab1f,lab1f,lab2v),
-    (lab1v,lab1v,lab2v),
-    (lab1f,lab1v,lab2v),
-    (lab1v,lab2f,lab2v)
-    ]
-
-gr2 = GraphMem { arcs=[]::[Arc LabelMem] }
-ga2 =
-    [
-    (lab1f,lab1f,lab1f),
-    (lab1v,lab1v,lab1v),
-    (lab2f,lab2f,lab2f),
-    (lab2v,lab2v,lab2v)
-    ]
-
-gr3 = GraphMem { arcs=[]::[Arc LabelMem] }
-ga3 =
-    [
-    (lab1f,lab1f,lab1v),
-    (lab1f,lab1f,lab2f),
-    (lab1f,lab1f,lab2v),
-    (lab1v,lab1v,lab1f),
-    (lab1v,lab1v,lab2f),
-    (lab1v,lab1v,lab2v),
-    (lab1f,lab1v,lab2f),
-    (lab1f,lab1v,lab2v),
-    (lab1v,lab2f,lab2v)
-    ]
-
-gl4 = [lab1f,lab1v,lab2f,lab2v]
-
-
-gr1a = setArcsT ga1 gr1
-testGraph01 = testeq "Graph01" ga1 (getArcsT gr1a)
-
-gr2a = setArcsT ga2 gr2
-testGraph02 = testeq "Graph01" ga2 (getArcsT gr2a)
-
-gr3a = setArcsT ga3 gr3
-testGraph03 = testeq "Graph03" ga3 (getArcsT gr3a)
-
-gr4a = add gr2a gr3a
-testGraph04 = testeqv "Graph04" ga1 (getArcsT gr4a)
-
-gr4b = add gr3a gr2a
-testGraph05 = testeqv "Graph05" ga1 (getArcsT gr4b)
-
-gr4c = delete gr2a gr4a
-testGraph06 = testeqv "Graph06" ga3 (getArcsT gr4c)
-
-gr4d = delete gr3a gr4a
-testGraph07 = testeqv "Graph07" ga2 (getArcsT gr4d)
-
-gr4e = extract gs4 gr4a
-testGraph08 = testeqv "Graph08" ga4 (getArcsT gr4e)
-gr4ee = map gs4 (getArcs gr4a)
-
-gl4f = labels gr4a
-testGraph09 = testeqv "Graph09" gl4 gl4f
-
-gr4g = add gr2a gr4a
-testGraph10 = testeq "Graph10" ga1 (getArcsT gr4g)
-
-testGraphSuite = TestList
-    [
-    testGraph01, testGraph02, testGraph03, testGraph04,
-    testGraph05, testGraph06, testGraph07, testGraph08,
-    testGraph09, testGraph10
-    ]
-
-------------------------------------------------------------
---
-------------------------------------------------------------
-
-------------------------------------------------------------
--- Define some common values
-------------------------------------------------------------
-
-s1 = LF "s1"
-s2 = LF "s2"
-s3 = LF "s3"
-s4 = LF ""
-s5 = LV "s5"
-s6 = LF "basemore"
-s7 = LF ("base"++"more")
-s8 = LV "s8"
-
-b1 = LV "b1"
-b2 = LV "b2"
-b3 = LV "b3"
-b4 = LV "b4"
-
-p1 = LF "p1"
-p2 = LF "p2"
-p3 = LF "p3"
-p4 = LF "p4"
-
-o1 = LF "o1"
-o2 = LF "o2"
-o3 = LF "o3"
-o4 = LF ""
-o5 = LV "o5"
-o6 = LV "s5"
-
-l1  = LF "l1"
-l2  = LF "l2-en"
-l3  = LF "l2-fr"
-l4  = LF "l4-type1"
-l5  = LF "l4-type1"
-l6  = LF "l4-type1"
-l7  = LF "l4-type2"
-l8  = LF "l4-type2"
-l9  = LF "l4-type2"
-l10 = LF "l10-xml"
-l11 = LF "l10-xml-en"
-l12 = LF "l10-xml-fr"
-
-v1  = LV "v1"
-v2  = LV "v2"
-v3  = LV "v3"
-v4  = LV "v4"
-
-------------------------------------------------------------
---  Label construction and equality tests
-------------------------------------------------------------
-
-testLabelEq :: String -> Bool -> LabelMem -> LabelMem -> Test
-testLabelEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
-
-nodelist =
-  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5),
-    ("s6",s6), ("s7",s7), ("s8",s8),
-    ("o5",o5),
-    ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4),
-    ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4),
-    ("l1",l1), ("l2",l2), ("l3",l3), ("l4",l4), ("l5",l5),
-    ("l6",l6), ("l7",l7), ("l8",l8), ("l9",l9),
-    ("l10",l10), ("l11",l11), ("l12",l12),
-    ("v1",v1), ("v2",v2)
-  ]
-
-nodeeqlist =
-  [
-    ("s4","o4"),
-    ("s5","o6"),
-    ("s6","s7"),
-    ("l4","l5"),
-    ("l4","l6"),
-    ("l5","l6"),
-    ("l7","l8"),
-    ("l7","l9"),
-    ("l8","l9")
-  ]
-
-testLabelEqSuite = TestList
-  [ testLabelEq (testLab l1 l2) (testEq  l1 l2) n1 n2
-      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` nodeeqlist ||
-            (l2,l1) `elem` nodeeqlist
-
-
-------------------------------------------------------------
---  Label ordering tests
-------------------------------------------------------------
-
-testLabelOrd :: String -> Ordering -> LabelMem -> LabelMem -> Test
-testLabelOrd lab order n1 n2 =
-    TestCase ( assertEqual ("testLabelOrd:"++lab) order (compare n1 n2) )
-
-nodeorder =
-  [
-    "o4",
-    "s4", "s6", "s7",
-    "l1", "l10", "l11", "l12", "l2", "l3", "l4", "l5", "l6", "l7", "l8", "l9",
-    "o1", "o2", "o3",
-    "p1", "p2", "p3", "p4",
-    "s1", "s2", "s3",
-    "b1", "b2", "b3", "b4",
-    "o5",
-    "s5", "s8",
-    "v1", "v2"
-  ]
-
-testLabelOrdSuite = TestList
-  [ testLabelOrd (testLab l1 l2) (testOrd l1 l2) n1 n2
-      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testOrd l1 l2
-      | testEq l1 l2  = EQ
-      | otherwise     = compare (fromJust $ elemIndex l1 nodeorder)
-                                (fromJust $ elemIndex l2 nodeorder)
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` nodeeqlist ||
-            (l2,l1) `elem` nodeeqlist
-
-
-------------------------------------------------------------
--- Statement construction and equality tests
-------------------------------------------------------------
-
-type Statement = Arc LabelMem
-
-testStmtEq :: String -> Bool -> Statement -> Statement -> Test
-testStmtEq lab eq t1 t2 =
-    TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )
-
-slist =
-  [
-    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)
-  ]
-
-plist =
-  [
-    ("p1",p1)
-  ]
-
-olist =
-  [ ("o1",o1), ("o4",o4), ("o5",o5),
-    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)
-  ]
-
-tlist =
-  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]
-    where
-    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o
-    trp (_,s) (_,p) (_,o) = Arc s p o
-
-stmteqlist =
-  [
-    ("s6.p1.l1", "s7.p1.l1"),
-    ("s6.p1.l4", "s7.p1.l4"),
-    ("s6.p1.l7", "s7.p1.l7"),
-    ("s6.p1.l7", "s7.p1.l8"),
-    ("s6.p1.l8", "s7.p1.l7"),
-    ("s6.p1.l8", "s7.p1.l8"),
-    ("s6.p1.l10","s7.p1.l10"),
-    ("s6.p1.o1", "s7.p1.o1"),
-    ("s6.p1.o4", "s7.p1.o4"),
-    ("s6.p1.o5", "s7.p1.o5"),
-    ("s1.p1.l7", "s1.p1.l8"),
-    ("s4.p1.l7", "s4.p1.l8"),
-    ("s5.p1.l7", "s5.p1.l8"),
-    ("s6.p1.l7", "s6.p1.l8"),
-    ("s7.p1.l7", "s7.p1.l8")
-  ]
-
-testStmtEqSuite = TestList
-  [ testStmtEq (testLab l1 l2) (testEq  l1 l2) t1 t2
-      | (l1,t1) <- tlist , (l2,t2) <- tlist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` stmteqlist ||
-            (l2,l1) `elem` stmteqlist
-
-------------------------------------------------------------
---  Graph element handling support routines
-------------------------------------------------------------
-
-lmap = tstLabelMap 5 [(s1,(1,1)),(s2,(2,2)),(s3,(3,3)),(s4,(4,4)),
-                      (o1,(1,1)),(o2,(2,2)),(o3,(3,3))]
-llst = ["s1","s2","s3","s4","o1","o2","o3"]
-
--- showLabelMap :: (Label lb) => LabelMap lb -> String
-testShowLabelMap = testeq "showLabelMap" showMap (show lmap)
-    where
-        showMap = "LabelMap gen=5, map=\n"++
-                  "    !s1:(1,1)\n"++
-                  "    !s2:(2,2)\n"++
-                  "    !s3:(3,3)\n"++
-                  "    !:(4,4)\n"++
-                  "    !o1:(1,1)\n"++
-                  "    !o2:(2,2)\n"++
-                  "    !o3:(3,3)"
-
--- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
-testMapLabelIndex01 = testeq "testMapLabelIndex01" (1,1) (mapLabelIndex lmap s1 )
-testMapLabelIndex02 = testeq "testMapLabelIndex02" (2,2) (mapLabelIndex lmap s2 )
-testMapLabelIndex03 = testeq "testMapLabelIndex03" (3,3) (mapLabelIndex lmap s3 )
-testMapLabelIndex04 = testeq "testMapLabelIndex04" (4,4) (mapLabelIndex lmap s4 )
-testMapLabelIndex05 = testeq "testMapLabelIndex05" (1,1) (mapLabelIndex lmap o1 )
-testMapLabelIndex06 = testeq "testMapLabelIndex06" (4,4) (mapLabelIndex lmap o4 )
-testMapLabelIndex07 = testeq "testMapLabelIndex07" nullLabelVal (mapLabelIndex lmap o5 )
-testMapLabelIndex08 = testeq "testMapLabelIndex08" nullLabelVal (mapLabelIndex lmap o6 )
-
--- setLabelHash :: (Label lb) => LabelMap lb -> (lb,Int) -> LabelMap lb
-lmap1 = setLabelHash lmap (s2,22)
-
-testMapLabelHash00 = testeq "mapLabelHash00" showMap (show lmap1)
-    where
-        showMap = "LabelMap gen=5, map=\n"++
-                  "    !s1:(1,1)\n"++
-                  "    !s2:(5,22)\n"++
-                  "    !s3:(3,3)\n"++
-                  "    !:(4,4)\n"++
-                  "    !o1:(1,1)\n"++
-                  "    !o2:(2,2)\n"++
-                  "    !o3:(3,3)"
-
-testMapLabelHash01 = testeq "MapLabelHash01" (1,1)  (mapLabelIndex lmap1 s1 )
-testMapLabelHash02 = testeq "MapLabelHash02" (5,22) (mapLabelIndex lmap1 s2 )
-testMapLabelHash03 = testeq "MapLabelHash03" (3,3)  (mapLabelIndex lmap1 s3 )
-testMapLabelHash04 = testeq "MapLabelHash04" (4,4)  (mapLabelIndex lmap1 s4 )
-testMapLabelHash05 = testeq "MapLabelHash05" (1,1)  (mapLabelIndex lmap1 o1 )
-testMapLabelHash06 = testeq "MapLabelHash06" (4,4)  (mapLabelIndex lmap1 o4 )
-testMapLabelHash07 = testeq "MapLabelHash07" nullLabelVal (mapLabelIndex lmap1 o5 )
-testMapLabelHash08 = testeq "MapLabelHash08" nullLabelVal (mapLabelIndex lmap1 o6 )
-
-lmap2a = setLabelHash lmap1  (o1,66)
-lmap2b = setLabelHash lmap2a (o5,67)
-testMapLabelHash11 = testeq "MapLabelHash11" (1,1)  (mapLabelIndex lmap2b s1 )
-testMapLabelHash12 = testeq "MapLabelHash12" (5,22) (mapLabelIndex lmap2b s2 )
-testMapLabelHash13 = testeq "MapLabelHash13" (3,3)  (mapLabelIndex lmap2b s3 )
-testMapLabelHash14 = testeq "MapLabelHash14" (4,4)  (mapLabelIndex lmap2b s4 )
-testMapLabelHash15 = testeq "MapLabelHash15" (5,66) (mapLabelIndex lmap2b o1 )
-testMapLabelHash16 = testeq "MapLabelHash16" (2,2)  (mapLabelIndex lmap2b o2 )
-testMapLabelHash17 = testeq "MapLabelHash17" (4,4)  (mapLabelIndex lmap2b o4 )
-testMapLabelHash18 = testeq "MapLabelHash18" nullLabelVal (mapLabelIndex lmap1 o5 )
-
--- newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
-lmap3 = newLabelMap lmap [(s1,61),(s3,63),(o2,66)]
-testLabelMap01 = testeq "LabelMap01" (6,61) (mapLabelIndex lmap3 s1 )
-testLabelMap02 = testeq "LabelMap02" (2,2)  (mapLabelIndex lmap3 s2 )
-testLabelMap03 = testeq "LabelMap03" (6,63) (mapLabelIndex lmap3 s3 )
-testLabelMap04 = testeq "LabelMap04" (4,4)  (mapLabelIndex lmap3 s4 )
-testLabelMap05 = testeq "LabelMap05" (1,1)  (mapLabelIndex lmap3 o1 )
-testLabelMap06 = testeq "LabelMap06" (6,66) (mapLabelIndex lmap3 o2 )
-
-testLabelMapSuite = TestList
-  [ testShowLabelMap
-  , testMapLabelIndex01
-  , testMapLabelIndex02
-  , testMapLabelIndex03
-  , testMapLabelIndex04
-  , testMapLabelIndex05
-  , testMapLabelIndex06
-  , testMapLabelIndex07
-  , testMapLabelIndex08
-  , testMapLabelHash00
-  , testMapLabelHash01
-  , testMapLabelHash02
-  , testMapLabelHash03
-  , testMapLabelHash04
-  , testMapLabelHash05
-  , testMapLabelHash06
-  , testMapLabelHash07
-  , testMapLabelHash08
-  , testMapLabelHash11
-  , testMapLabelHash12
-  , testMapLabelHash13
-  , testMapLabelHash14
-  , testMapLabelHash15
-  , testMapLabelHash16
-  , testMapLabelHash17
-  , testMapLabelHash18
-  , testLabelMap01
-  , testLabelMap02
-  , testLabelMap03
-  , testLabelMap04
-  , testLabelMap05
-  ]
-
-------------------------------------------------------------
---  Graph matching support
-------------------------------------------------------------
-
-t01 = toStatement s1 p1 o1
-t02 = toStatement s2 p1 o2
-t03 = toStatement s3 p1 o3
-t04 = toStatement s1 p1 l1
-t05 = toStatement s2 p1 l4
-t06 = toStatement s3 p1 l10
-
-t10 = toStatement s1 p1 b1
-t11 = toStatement b1 p2 b2
-t12 = toStatement b2 p3 o1
-
-t20 = toStatement s1 p1 b3
-t21 = toStatement b3 p2 b4
-t22 = toStatement b4 p3 o1
-
-as1 = [t01]
-
-as2 = [t01,t02,t03,t04,t05,t06]
-
-as4 = [t01,t02,t03,t04,t05,t06,t10,t11,t12]
-
-as5 = [t01,t02,t03,t04,t05,t06,t20,t21,t22]
-
-as6 = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
-
-
--- graphLabels :: (Label lb) => [Arc lb] -> [lb]
-ls4 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]
-testGraphLabels04 = testeqv "GraphLabels04" ls4 (graphLabels as4)
-testGraphLabels14 = testeq  "GraphLabels14" str (show (graphLabels as4))
-    where
-        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]"
-        -- str = "[!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
-
-ls5 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]
-testGraphLabels05 = testeqv "GraphLabels05" ls5 (graphLabels as5)
-testGraphLabels15 = testeq  "GraphLabels15" str (show (graphLabels as5))
-    where
-        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]"
-        -- str = "[!p3,?b4,!p2,?b3,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
-
-ls6 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]
-testGraphLabels06 = testeqv "GraphLabels05" ls6 (graphLabels as6)
-testGraphLabels16 = testeq  "GraphLabels16" str (show (graphLabels as6))
-    where
-        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"++
-              ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]"
-        -- str = "[?b4,?b3,!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1"++
-        --       ",!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
-
--- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
-
-lmap5 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),
-                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),
-                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),
-                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),
-                       (b3,(1,262143)),(b4,(1,262143))]
-testAssignLabelMap05 = testeq "AssignLabels05" lmap5
-                        (newGenerationMap $ assignLabelMap ls5 emptyMap)
-
-lmap6 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),
-                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),
-                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),
-                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),
-                       (b1,(2,262143)),(b2,(2,262143)),(b3,(1,262143)),(b4,(1,262143))]
-testAssignLabelMap06 = testeq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)
-
-
-lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)),
-                       (p1,(1,21)),(p2,(1,22)),(p3,(1,13)),
-                       (o1,(1,31)),(o2,(1,32)),(o3,(1,13)),
-                       (l1,(1,41)),(l4,(1,42)),(l10,(1,43)),
-                       (b1,(1,51)),(b2,(1,51)),(b3,(1,51)),(b4,(1,51))]
-
--- [[[TODO: test hash value collision on non-variable label]]]
-
-testGraphMatchSupportSuite = TestList
-  [ testGraphLabels04
-  , testGraphLabels14
-  , testGraphLabels05
-  , testGraphLabels15
-  , testGraphLabels06
-  , testGraphLabels16
-  , testAssignLabelMap05
-  , testAssignLabelMap06
-  ]
-
-------------------------------------------------------------
---  Test steps in graph equality test
-------------------------------------------------------------
-
-matchable l1 l2 = True
-
-s1_1 = makeScopedLabel 1 s1
-s2_1 = makeScopedLabel 1 s2
-s3_1 = makeScopedLabel 1 s3
-p1_1 = makeScopedLabel 1 p1
-p2_1 = makeScopedLabel 1 p2
-p3_1 = makeScopedLabel 1 p3
-o1_1 = makeScopedLabel 1 o1
-o2_1 = makeScopedLabel 1 o2
-o3_1 = makeScopedLabel 1 o3
-l1_1 = makeScopedLabel 1 l1
-l4_1 = makeScopedLabel 1 l4
-l10_1 = makeScopedLabel 1 l10
-b1_1 = makeScopedLabel 1 b1
-b2_1 = makeScopedLabel 1 b2
-b3_1 = makeScopedLabel 1 b3
-b4_1 = makeScopedLabel 1 b4
-
-s1_2 = makeScopedLabel 2 s1
-s2_2 = makeScopedLabel 2 s2
-s3_2 = makeScopedLabel 2 s3
-p1_2 = makeScopedLabel 2 p1
-p2_2 = makeScopedLabel 2 p2
-p3_2 = makeScopedLabel 2 p3
-o1_2 = makeScopedLabel 2 o1
-o2_2 = makeScopedLabel 2 o2
-o3_2 = makeScopedLabel 2 o3
-l1_2 = makeScopedLabel 2 l1
-l4_2 = makeScopedLabel 2 l4
-l10_2 = makeScopedLabel 2 l10
-b1_2 = makeScopedLabel 2 b1
-b2_2 = makeScopedLabel 2 b2
-b3_2 = makeScopedLabel 2 b3
-b4_2 = makeScopedLabel 2 b4
-
-t01_1 = makeScopedArc 1 t01
-
-t01_2 = makeScopedArc 2 t01
-t02_2 = makeScopedArc 2 t02
-t03_2 = makeScopedArc 2 t03
-t04_2 = makeScopedArc 2 t04
-t05_2 = makeScopedArc 2 t05
-t06_2 = makeScopedArc 2 t06
-
-t10_1 = makeScopedArc 1 t10
-t11_1 = makeScopedArc 1 t11
-t12_1 = makeScopedArc 1 t12
-t20_1 = makeScopedArc 1 t20
-t21_1 = makeScopedArc 1 t21
-t22_1 = makeScopedArc 1 t22
-
-t10_2 = makeScopedArc 2 t10
-t11_2 = makeScopedArc 2 t11
-t12_2 = makeScopedArc 2 t12
-t20_2 = makeScopedArc 2 t20
-t21_2 = makeScopedArc 2 t21
-t22_2 = makeScopedArc 2 t22
-
--- Compare graph as6 with self, in steps
-
-as61 = map (makeScopedArc 1) as6
-as62 = map (makeScopedArc 2) as6
-
-eq1lmap     = newGenerationMap $
-              assignLabelMap (graphLabels as62) $
-              assignLabelMap (graphLabels as61) emptyMap
-eq1ltst     = tstLabelMap 2 [
-                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                             (b1_1,(1,262143)),(b2_1,(1,262143)),(b3_1,(1,262143)),(b4_1,(1,262143)),
-                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                             (b1_2,(1,262143)),(b2_2,(1,262143)),(b3_2,(1,262143)),(b4_2,(1,262143))
-                            ]
-testEqAssignMap01 = testeq "EqAssignMap01" eq1ltst eq1lmap
-
-eq1hs1      = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1]
-eq1hs2      = [t10_2,t11_2,t12_2,t20_2,t21_2,t22_2]
-
-eq1lmap'    = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),
-                                                (b3_1,(2,3880463)),
-                                                (b4_1,(2,3400925)),
-                             (b1_2,(2,3880463)),(b2_2,(2,3400925)),
-                                                (b3_2,(2,3880463)),
-                                                (b4_2,(2,3400925))]
-
-eq1lmap''   = newLabelMap eq1lmap'
-                [
-                (b1_1,2576315),(b2_1,3400925),(b3_1,1571691),
-                (b1_2,2576315),(b2_2,3400925),(b3_2,1571691)
-                ]
-eq1ltst''   = tstLabelMap 3 [
-                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                            (b1_1,(3,2576315)),
-                            (b2_1,(3,3400925)),
-                            (b3_1,(3,1571691)),
-                            (b4_1,(2,3400925)),
-                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                            (b1_2,(3,2576315)),
-                            (b2_2,(3,3400925)),
-                            (b3_2,(3,1571691)),
-                            (b4_2,(2,3400925))
-                            ]
-testEqNewLabelMap07 = testeq "EqNewLabelMap07" eq1ltst'' eq1lmap''
-
--- Repeat same tests for as4...
-
-as41 = map (makeScopedArc 1) as4
-as42 = map (makeScopedArc 2) as4
-
-eq2lmap     = newGenerationMap $
-              assignLabelMap (graphLabels as42) $
-              assignLabelMap (graphLabels as41) emptyMap
-eq2ltst     = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                             (b1_1,(1,262143)),(b2_1,(1,262143)),
-                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                             (b1_2,(1,262143)),(b2_2,(1,262143))]
-testEqAssignMap21 = testeq "EqAssignMap21" eq2ltst eq2lmap
-
-eq2hs1      = [t10_1,t11_1,t12_1]
-eq2hs2      = [t10_2,t11_2,t12_2]
-
-eq2lmap'    = tstLabelMap 2 [
-                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),
-                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                             (b1_2,(2,3880463)),(b2_2,(2,3400925))
-                            ]
-
-eq2lmap''   = newLabelMap eq2lmap'
-                [
-                (b2_1,3400925),
-                (b2_2,3400925)
-                ]
-eq2ltst''   = tstLabelMap 3 [
-                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
-                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
-                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
-                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
-                            (b1_1,(2,3880463)),
-                            (b2_1,(3,3400925)),
-                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
-                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
-                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
-                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
-                            (b1_2,(2,3880463)),
-                            (b2_2,(3,3400925))
-                            ]
-testEqNewLabelMap27 = testeq "EqNewLabelMap27" eq2ltst'' eq2lmap''
-
--- Compare as1 with as2, in steps
-
-as11 = map (makeScopedArc 1) as1
-as22 = map (makeScopedArc 2) as2
-
-eq3hs1   = [t01_1]
-eq3hs2   = [t01_2,t02_2,t03_2,t04_2,t05_2,t06_2]
-
-testEqGraphMap31_1 = testeq "testEqGraphMap31_1" eq3hs1 as11
-testEqGraphMap31_2 = testeq "testEqGraphMap31_2" eq3hs2 as22
-
-eq3lmap     = newGenerationMap $
-              assignLabelMap (graphLabels as11) $
-              assignLabelMap (graphLabels as22) emptyMap
-eq3ltst     = tstLabelMap 2
-    [ (s1_1,(1,142577))
-    , (p1_1,(1,142385))
-    , (o1_1,(1,142321))
-    , (s1_2,(1,142577)), (s2_2,(1,142578)), (s3_2,(1,142579))
-    , (p1_2,(1,142385))
-    , (o1_2,(1,142321)), (o2_2,(1,142322)), (o3_2,(1,142323))
-    , (l1_2,(1,142129)), (l4_2,(1,1709580)), (l10_2,(1,3766582))
-    ]
-testEqAssignMap32 = testeq "EqAssignMap32" eq3ltst eq3lmap
-
-ec31     = equivalenceClasses eq3lmap (graphLabels as11)
-ec31test =
-    [ ((1,142321),[o1_1])
-    , ((1,142385),[p1_1])
-    , ((1,142577),[s1_1])
-    ]
-
-ec32 = equivalenceClasses eq3lmap (graphLabels as22)
-ec32test =
-    [ ((1,142129),[l1_2])
-    , ((1,142321),[o1_2])
-    , ((1,142322),[o2_2])
-    , ((1,142323),[o3_2])
-    , ((1,142385),[p1_2])
-    , ((1,142577),[s1_2])
-    , ((1,142578),[s2_2])
-    , ((1,142579),[s3_2])
-    , ((1,1709580),[l4_2])
-    , ((1,3766582),[l10_2])
-    ]
-
-testEquivClass33_1 = testeq "EquivClass33_1" ec31test ec31
-testEquivClass33_2 = testeq "EquivClass33_2" ec32test ec32
-
--- This value is nonsense for this test,
--- but a parameter is needed for graphMatch1 (below)
-ec3pairs = zip (pairSort ec31) (pairSort ec32)
-ec3test  =
-    [ ( ((1,142321),[o1_1]), ((1,142321),[o1_2]) )
-    , ( ((1,142385),[p1_1]), ((1,142385),[p1_2]) )
-    , ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) )
-    ]
-
-{-  This is a pointless test in this case
-testEquivClass33_3 = testeq "EquivClass33_3" ec3test ec3pairs
--}
-
-eq3lmap1 = graphMatch1 False matchable eq3hs1 eq3hs2 eq3lmap ec3pairs
-eq3ltst1 = tstLabelMap 2
-    [ (o1_1,(1,142321))
-    , (p1_1,(1,142385))
-    , (s1_1,(1,142577))
-    , (l10_2,(1,3766582))
-    , (l4_2,(1,1709580))
-    , (l1_2,(1,142129))
-    , (o3_2,(1,142323))
-    , (s3_2,(1,142579))
-    , (o2_2,(1,142322))
-    , (s2_2,(1,142578))
-    , (o1_2,(1,142321))
-    , (p1_2,(1,142385))
-    , (s1_2,(1,142577))
-    ]
--- testEqAssignMap34 = testeq "EqAssignMap34" (Just eq3ltst1) eq3lmap1
--- testEqAssignMap34 = testeq "EqAssignMap34" Nothing eq3lmap1
-testEqAssignMap34 = testeq "EqAssignMap34" False (fst eq3lmap1)
-
-{-
-eq3rc1      = reclassify eq3hs1 eq3lmap
-eq3rctst1   = []
-testEqReclassify35_1 = testeqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1
-eq3rc2      = reclassify eq3hs2 eq3lmap
-eq3rctst2   = []
-testEqReclassify35_2 = testeqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2
--}
-
-
--- Test suite
-
-testGraphMatchStepSuite = TestList
-  [ testEqAssignMap01
-  -- , testEqReclassify03_1, testEqReclassify03_2
-  , testEqNewLabelMap07
-  -- , testEqGraphMatch08
-  , testEqAssignMap21
-  -- , testEqReclassify23_1, testEqReclassify23_2
-  , testEqNewLabelMap27
-  -- , testEqGraphMatch28
-  , testEqGraphMap31_1, testEqGraphMap31_2
-  , testEqAssignMap32
-  , testEquivClass33_1, testEquivClass33_2 -- , testEquivClass33_3
-  , testEqAssignMap34
-  -- , testEqReclassify35_1, testEqReclassify35_2
-  ]
-
-------------------------------------------------------------
---  Graph equality tests
-------------------------------------------------------------
-
-testGraphEq :: ( Label lb ) => String -> Bool -> GraphMem lb -> GraphMem lb -> Test
-testGraphEq lab eq g1 g2 =
-    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-
-g1 = GraphMem { arcs = [t01] }
-
-g2 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06] }
-
-g3 = GraphMem { arcs = [t06,t05,t04,t03,t02,t01] }
-
-g4 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12] }
-
-g5 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t20,t21,t22] }
-
-g6 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] }
-
-g7 = GraphMem { arcs = [t01,t02] }
-
-g8 = GraphMem { arcs = [t02,t01] }
-
-glist =
-  [ ("g1",g1), ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6) ]
-
-grapheqlist =
-  [ ("g2","g3")
-  , ("g4","g5")
-  ]
-
-testGraphEqSuitePart = TestLabel "testGraphEqSuitePart" $ TestList
-  [ testGraphEq "g1-g2" False g1 g2
-  , testGraphEq "g2-g1" False g2 g1
-  , testGraphEq "g2-g2" True  g2 g2
-  , testGraphEq "g2-g3" True  g2 g3
-  , testGraphEq "g1-g4" False g1 g4
-  , testGraphEq "g2-g4" False g2 g4
-  , testGraphEq "g3-g4" False g3 g4
-  , testGraphEq "g4-g3" False g4 g3
-  , testGraphEq "g4-g4" True  g4 g4
-  , testGraphEq "g4-g5" True  g4 g5
-  , testGraphEq "g4-g6" False g4 g6
-  , testGraphEq "g6-g6" True  g6 g6
-  , testGraphEq "g7-g7" True  g7 g7
-  , testGraphEq "g7-g8" True  g7 g8
-  , testGraphEq "g8-g7" True  g8 g7
-  ]
-
-testGraphEqSuite = TestLabel "testGraphEqSuite" $ TestList
-  [ testGraphEq (testLab l1 l2) (testEq l1 l2) g1 g2
-      | (l1,g1) <- glist , (l2,g2) <- glist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` grapheqlist ||
-            (l2,l1) `elem` grapheqlist
-
--- Selected tests for debugging
-geq12 = testGraphEq "g1-g2" False g1 g2
-geq21 = testGraphEq "g2-g1" False g2 g1
-geq22 = testGraphEq "g2-g2" True  g2 g2
-geq23 = testGraphEq "g2-g3" True  g2 g3
-geq14 = testGraphEq "g1-g4" False g1 g4
-geq24 = testGraphEq "g2-g4" False g2 g4
-geq77 = testGraphEq "g7-g7" True  g7 g7
-geq78 = testGraphEq "g7-g8" True  g7 g8
-geq87 = testGraphEq "g8-g7" True  g8 g7
-
-
-------------------------------------------------------------
---  More graph equality tests
-------------------------------------------------------------
---
---  These tests are based on the 10-node, triply connected
---  graph examples in Jeremy Carroll's paper on matching RDF
---  graphs.
-
---  Graph pattern 1:
---  pentangle-in-pentangle, corresponding vertices linked upward
-
-v101  = LV "v101"
-v102  = LV "v102"
-v103  = LV "v103"
-v104  = LV "v104"
-v105  = LV "v105"
-v106  = LV "v106"
-v107  = LV "v107"
-v108  = LV "v108"
-v109  = LV "v109"
-v110  = LV "v110"
-
-p101  = LV "p101"
-p102  = LV "p102"
-p103  = LV "p103"
-p104  = LV "p104"
-p105  = LV "p105"
-p106  = LV "p106"
-p107  = LV "p107"
-p108  = LV "p108"
-p109  = LV "p109"
-p110  = LV "p110"
-p111  = LV "p111"
-p112  = LV "p112"
-p113  = LV "p113"
-p114  = LV "p114"
-p115  = LV "p115"
-
-t10102 = toStatement v101 p101 v102
-t10203 = toStatement v102 p102 v103
-t10304 = toStatement v103 p103 v104
-t10405 = toStatement v104 p104 v105
-t10501 = toStatement v105 p105 v101
-t10106 = toStatement v101 p106 v106
-t10207 = toStatement v102 p107 v107
-t10308 = toStatement v103 p108 v108
-t10409 = toStatement v104 p109 v109
-t10510 = toStatement v105 p110 v110
-t10607 = toStatement v106 p111 v107
-t10708 = toStatement v107 p112 v108
-t10809 = toStatement v108 p113 v109
-t10910 = toStatement v109 p114 v110
-t11006 = toStatement v110 p115 v106
-
---  Graph pattern 2:
---  pentangle-in-pentangle, corresponding vertices linked downward
-
-v201  = LV "v201"
-v202  = LV "v202"
-v203  = LV "v203"
-v204  = LV "v204"
-v205  = LV "v205"
-v206  = LV "v206"
-v207  = LV "v207"
-v208  = LV "v208"
-v209  = LV "v209"
-v210  = LV "v210"
-
-p201  = LV "p201"
-p202  = LV "p202"
-p203  = LV "p203"
-p204  = LV "p204"
-p205  = LV "p205"
-p206  = LV "p206"
-p207  = LV "p207"
-p208  = LV "p208"
-p209  = LV "p209"
-p210  = LV "p210"
-p211  = LV "p211"
-p212  = LV "p212"
-p213  = LV "p213"
-p214  = LV "p214"
-p215  = LV "p215"
-
-t20102 = toStatement v201 p201 v202
-t20203 = toStatement v202 p202 v203
-t20304 = toStatement v203 p203 v204
-t20405 = toStatement v204 p204 v205
-t20501 = toStatement v205 p205 v201
-t20601 = toStatement v206 p206 v201
-t20702 = toStatement v207 p207 v202
-t20803 = toStatement v208 p208 v203
-t20904 = toStatement v209 p209 v204
-t21005 = toStatement v210 p210 v205
-t20607 = toStatement v206 p211 v207
-t20708 = toStatement v207 p212 v208
-t20809 = toStatement v208 p213 v209
-t20910 = toStatement v209 p214 v210
-t21006 = toStatement v210 p215 v206
-
---  Graph pattern 3:
---  star-in-pentangle, corresponding vertices linked toward star
---  Although this graph is similarly linked to patterns 1 and 2,
---  it is topologically different as it contains circuits only of
---  length 5, where the others have circuits of length 4 and 5
---  (ignoring direction of arcs)
-
-v301  = LV "v301"
-v302  = LV "v302"
-v303  = LV "v303"
-v304  = LV "v304"
-v305  = LV "v305"
-v306  = LV "v306"
-v307  = LV "v307"
-v308  = LV "v308"
-v309  = LV "v309"
-v310  = LV "v310"
-
-p301  = LV "p301"
-p302  = LV "p302"
-p303  = LV "p303"
-p304  = LV "p304"
-p305  = LV "p305"
-p306  = LV "p306"
-p307  = LV "p307"
-p308  = LV "p308"
-p309  = LV "p309"
-p310  = LV "p310"
-p311  = LV "p311"
-p312  = LV "p312"
-p313  = LV "p313"
-p314  = LV "p314"
-p315  = LV "p315"
-
-t30102 = toStatement v301 p301 v302
-t30203 = toStatement v302 p302 v303
-t30304 = toStatement v303 p303 v304
-t30405 = toStatement v304 p304 v305
-t30501 = toStatement v305 p305 v301
-t30106 = toStatement v301 p306 v306
-t30207 = toStatement v302 p307 v307
-t30308 = toStatement v303 p308 v308
-t30409 = toStatement v304 p309 v309
-t30510 = toStatement v305 p310 v310
-t30608 = toStatement v306 p311 v308
-t30709 = toStatement v307 p312 v309
-t30810 = toStatement v308 p313 v310
-t30906 = toStatement v309 p314 v306
-t31007 = toStatement v310 p315 v307
-
---  Graph pattern 4:
---  pentangle-in-pentangle, corresponding vertices linked upward
---  The vertices 6-10 are linked in reverse order to the
---  corresponding vertices 1-5.
-
-v401  = LV "v401"
-v402  = LV "v402"
-v403  = LV "v403"
-v404  = LV "v404"
-v405  = LV "v405"
-v406  = LV "v406"
-v407  = LV "v407"
-v408  = LV "v408"
-v409  = LV "v409"
-v410  = LV "v410"
-
-p401  = LV "p401"
-p402  = LV "p402"
-p403  = LV "p403"
-p404  = LV "p404"
-p405  = LV "p405"
-p406  = LV "p406"
-p407  = LV "p407"
-p408  = LV "p408"
-p409  = LV "p409"
-p410  = LV "p410"
-p411  = LV "p411"
-p412  = LV "p412"
-p413  = LV "p413"
-p414  = LV "p414"
-p415  = LV "p415"
-
-t40102 = toStatement v401 p401 v402
-t40203 = toStatement v402 p402 v403
-t40304 = toStatement v403 p403 v404
-t40405 = toStatement v404 p404 v405
-t40501 = toStatement v405 p405 v401
-t40106 = toStatement v401 p406 v406
-t40207 = toStatement v402 p407 v407
-t40308 = toStatement v403 p408 v408
-t40409 = toStatement v404 p409 v409
-t40510 = toStatement v405 p410 v410
-t41009 = toStatement v410 p411 v409
-t40908 = toStatement v409 p412 v408
-t40807 = toStatement v408 p413 v407
-t40706 = toStatement v407 p414 v406
-t40610 = toStatement v406 p415 v410
-
---  Graph pattern 5:
---  Same as pattern 1, except same fixed property in all cases.
-
-p5    = LF "p5"
-
-t50102 = toStatement v101 p5 v102
-t50203 = toStatement v102 p5 v103
-t50304 = toStatement v103 p5 v104
-t50405 = toStatement v104 p5 v105
-t50501 = toStatement v105 p5 v101
-t50106 = toStatement v101 p5 v106
-t50207 = toStatement v102 p5 v107
-t50308 = toStatement v103 p5 v108
-t50409 = toStatement v104 p5 v109
-t50510 = toStatement v105 p5 v110
-t50607 = toStatement v106 p5 v107
-t50708 = toStatement v107 p5 v108
-t50809 = toStatement v108 p5 v109
-t50910 = toStatement v109 p5 v110
-t51006 = toStatement v110 p5 v106
-
---  Graph pattern 6:
---  Same as pattern 5, with different variables
-
-t60102 = toStatement v201 p5 v202
-t60203 = toStatement v202 p5 v203
-t60304 = toStatement v203 p5 v204
-t60405 = toStatement v204 p5 v205
-t60501 = toStatement v205 p5 v201
-t60106 = toStatement v201 p5 v206
-t60207 = toStatement v202 p5 v207
-t60308 = toStatement v203 p5 v208
-t60409 = toStatement v204 p5 v209
-t60510 = toStatement v205 p5 v210
-t60607 = toStatement v206 p5 v207
-t60708 = toStatement v207 p5 v208
-t60809 = toStatement v208 p5 v209
-t60910 = toStatement v209 p5 v210
-t61006 = toStatement v210 p5 v206
-
---
-
-arcsToGraph as = GraphMem { arcs = as }
-
--- Very simple case
-
-g100 = arcsToGraph
-       [ t10102, t10203, t10304, t10405, t10501,
-         t10607, t10708, t10809, t10910, t11006
-       ]
-
-g200 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20607, t20708, t20809, t20910, t21006
-       ]
-
--- 10/3 node graph comparisons
-
-g101 = arcsToGraph
-       [ t10102, t10203, t10304, t10405, t10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g201 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803, t20904, t21005,
-         t20607, t20708, t20809, t20910, t21006 ]
-
-g301 = arcsToGraph
-       [ t30102, t30203, t30304, t30405, t30501,
-         t30106, t30207, t30308, t30409, t30510,
-         t30608, t30709, t30810, t30906, t31007 ]
-
-g401 = arcsToGraph
-       [ t40102, t40203, t40304, t40405, t40501,
-         t40106, t40207, t40308, t40409, t40510,
-         t40610, t40706, t40807, t40908, t41009 ]
-
-g501 = arcsToGraph
-       [ t50102, t50203, t50304, t50405, t50501,
-         t50106, t50207, t50308, t50409, t50510,
-         t50607, t50708, t50809, t50910, t51006 ]
-
-g601 = arcsToGraph
-       [ t60102, t60203, t60304, t60405, t60501,
-         t60106, t60207, t60308, t60409, t60510,
-         t60607, t60708, t60809, t60910, t61006 ]
-
--- Remove one arc from each
-
-g102 = arcsToGraph
-       [ t10102, t10203, t10304, t10405,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g202 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803, t20904, t21005,
-                 t20708, t20809, t20910, t21006 ]
-
-g302 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803, t20904,
-         t20607, t20708, t20809, t20910, t21006 ]
-
--- Remove two adjacent arcs from each
-
-g103 = arcsToGraph
-       [ t10102, t10203, t10304,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g203 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803, t20904, t21005,
-         t20607, t20708,                 t21006 ]
-
-g303 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803, t20904,
-         t20607, t20708, t20809,         t21006 ]
-
--- Remove two adjacent arcs from one, non-adjacent from another
-
-g104 = arcsToGraph
-       [ t10102, t10203, t10304,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g204 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20601, t20702, t20803,
-         t20607, t20708, t20809, t20910, t21006 ]
-
--- Compare two rings of 5 with one ring of 10
--- (each node double-connected, but different overall topology)
-
-t10901 = toStatement v109 p109 v101
-
-g105 = arcsToGraph
-       [ t10102, t10203, t10304, t10405,
-                                 t10901, t10510,
-         t10607, t10708, t10809,         t11006 ]
-
-g205 = arcsToGraph
-       [ t20102, t20203, t20304, t20405, t20501,
-         t20607, t20708, t20809, t20910, t21006 ]
-
--- Reverse one arc from test 01
--- (also, rearrange arcs to catch ordering artefacts)
-
-t20201 = toStatement v202 p201 v201
-
-g106 = arcsToGraph
-       [ t10102, t10203, t10304, t10405, t10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g206 = arcsToGraph
-       [ t20607, t20708, t20809, t20910, t21006,
-         t20601, t20702, t20803, t20904, t21005,
-         t20102, t20203, t20304, t20405, t20501 ]
-
-g306 = arcsToGraph
-       [ t20607, t20708, t20809, t20910, t21006,
-         t20601, t20702, t20803, t20904, t21005,
-         t20201, t20203, t20304, t20405, t20501 ]
-
--- Similar tests to 02,03,04,
--- but add identified property rather than removing arcs
-
-f01  = LF "f01"
-f02  = LF "f02"
-
--- Fix one arc from each
-
-f10102 = toStatement v101 f01 v102
-f10501 = toStatement v105 f01 v101
-f21006 = toStatement v210 f01 v206
-f20510 = toStatement v205 f01 v210
-
-g107 = arcsToGraph
-       [ f10102, t10203, t10304, t10405, t10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g207 = arcsToGraph
-       [ t10102, t10203, t10304, t10405, f10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g307 = arcsToGraph
-       [ t20607, t20708, t20809, t20910, f21006,
-         t20601, t20702, t20803, t20904, t21005,
-         t20102, t20203, t20304, t20405, t20501 ]
-
-g407 = arcsToGraph
-       [ t20607, t20708, t20809, t20910, t21006,
-         t20601, t20702, t20803, t20904, t21005,
-         t20102, t20203, t20304, t20405, t20501 ]
-
--- Fix two adjacent arcs from each
-
-f10203 = toStatement v102 f01 v103
-f10405 = toStatement v104 f01 v105
-f20910 = toStatement v209 f01 v210
-f20601 = toStatement v206 f01 v201
-
-g108 = arcsToGraph
-       [ f10102, f10203, t10304, t10405, t10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g208 = arcsToGraph
-       [ t10102, t10203, t10304, f10405, f10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g308 = arcsToGraph
-       [ t20607, t20708, t20809, f20910, f21006,
-         t20601, t20702, t20803, t20904, t21005,
-         t20102, t20203, t20304, t20405, t20501 ]
-
-g408 = arcsToGraph
-       [ t20607, t20708, t20809, t20910, f21006,
-         f20601, t20702, t20803, t20904, t21005,
-         t20102, t20203, t20304, t20405, t20501 ]
-
--- Fix two adjacent arcs with different properties
-
-g10203 = toStatement v102 f02 v103
-g10102 = toStatement v101 f02 v102
-g10405 = toStatement v104 f02 v105
-
-g109 = arcsToGraph
-       [ f10102, g10203, t10304, t10405, t10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g209 = arcsToGraph
-       [ g10102, t10203, t10304, t10405, f10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-g309 = arcsToGraph
-       [ t10102, t10203, t10304, g10405, f10501,
-         t10106, t10207, t10308, t10409, t10510,
-         t10607, t10708, t10809, t10910, t11006 ]
-
-
-mgeq00 = testGraphEq "g100-g200" True  g100 g200
-
-mgeq0112 = testGraphEq "g101-g201" True  g101 g201
-mgeq0113 = testGraphEq "g101-g301" False g101 g301
-mgeq0114 = testGraphEq "g101-g401" False g101 g401
-mgeq0115 = testGraphEq "g101-g501" False g101 g501
-mgeq0116 = testGraphEq "g101-g601" False g101 g601
-mgeq0156 = testGraphEq "g501-g601" True  g501 g601
-
-mgeq0212 = testGraphEq "g102-g202" True  g102 g202
-mgeq0213 = testGraphEq "g102-g302" False g102 g302
-
-mgeq0312 = testGraphEq "g103-g203" True  g103 g203
-mgeq0313 = testGraphEq "g103-g303" False g103 g303
-
-mgeq04 = testGraphEq "g104-g204" False g104 g204
-mgeq05 = testGraphEq "g105-g205" False g105 g205
-
-mgeq0612 = testGraphEq "g106-g206" True  g106 g206
-mgeq0613 = testGraphEq "g106-g306" False g106 g306
-
-mgeq0712 = testGraphEq "g107-g207" True  g107 g207
-mgeq0713 = testGraphEq "g107-g307" True  g107 g307
-mgeq0714 = testGraphEq "g107-g407" False g107 g407
-
-mgeq0812 = testGraphEq "g108-g208" True  g108 g208
-mgeq0813 = testGraphEq "g108-g308" True  g108 g308
-mgeq0814 = testGraphEq "g108-g408" False g108 g408
-
-mgeq0912 = testGraphEq "g109-g209" True  g109 g209
-mgeq0913 = testGraphEq "g109-g309" False g109 g309
-
-testGraphEqSuiteMore = TestList
-  [ mgeq00
-  , mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156
-  , mgeq0212, mgeq0213
-  , mgeq0312, mgeq0313
-  , mgeq04
-  , mgeq05
-  , mgeq0612, mgeq0613
-  , mgeq0712, mgeq0713, mgeq0714
-  , mgeq0812, mgeq0813, mgeq0814
-  , mgeq0912, mgeq0913
-  ]
-
-------------------------------------------------------------
--- All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ testSelectSuite
-  , testMapsetSuite
-  , testSubsetSuite
-  , testHashSuite
-  , testLabSuite
-  , testGraphSuite
-  , testLabelEqSuite
-  , testLabelOrdSuite
-  , testStmtEqSuite
-  , testLabelMapSuite
-  , testGraphMatchSupportSuite
-  , testGraphMatchStepSuite
-  , testGraphEqSuitePart
-  , testGraphEqSuite
-  , testGraphEqSuiteMore
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-geq    = testGraphEqSuite
-geq1   = testGraphEqSuiteMore
-ttmore = tt testGraphEqSuiteMore    -- this test may take a long time
-tfmore = tf testGraphEqSuiteMore
-ttstep = tt testGraphMatchStepSuite
-tfstep = tf testGraphMatchStepSuite
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/GraphTest.hs,v $
--- $Author: graham $
--- $Revision: 1.24 $
--- $Log: GraphTest.hs,v $
--- Revision 1.24  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.23  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.22  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.21  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.20  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.19  2003/05/29 01:50:56  graham
--- More performance tuning, courtesy of GHC profiler.
--- All modules showing reasonable performance now.
---
--- Revision 1.18  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.17  2003/05/23 16:29:20  graham
--- Partial code cleanup:
--- - Arc is an alebraic type
--- - Arc is an instance of Functor
--- - add gmap function to Graph interface
--- - remove some duplicate functions from GraphMatch
--- This in preparation for adding graph merge facility with
--- blank node renaming.
---
--- Revision 1.16  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.15  2003/05/14 11:13:15  graham
--- Fixed bug in graph matching.
--- (A graph-equivalence check is needed to weed out false matches
--- caused by the "guessing" stage.)
---
--- Revision 1.14  2003/05/14 02:01:59  graham
--- GraphMatch recoded and almost working, but
--- there are a couple of
--- obscure bugs that are proving rather stubborn to squash.
---
--- Revision 1.13  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.12  2003/05/07 19:26:32  graham
--- Sync
---
--- Revision 1.11  2003/05/01 23:15:44  graham
--- GraphTest passes all tests using refactored LookupMap
--- Extensive changes to GraphMatch were required.
---
--- Revision 1.10  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.9  2003/04/11 18:12:10  graham
--- Renamed GraphHelpers to ListHelpers
--- LookupMapTest, GraphTest, RDFGraphTest all run OK
---
--- Revision 1.8  2003/04/11 18:04:49  graham
--- Rename GraphLookupMap to LookupMap:
--- GraphTest runs OK.
---
--- Revision 1.7  2003/04/10 13:41:22  graham
--- More graph code tidying
--- Graph test cases still run OK
---
--- Revision 1.6  2003/04/10 13:35:34  graham
--- Separated GraphMatch logic from GraphMem
---
--- Revision 1.5  2003/04/10 08:36:06  graham
--- Graph matching passes battery of new tests
--- Started work on RDF graph
---
--- Revision 1.4  2003/03/31 22:18:08  graham
--- Simple graph equality tests all pass
---
--- Revision 1.3  2003/03/31 20:52:23  graham
--- Restructure graph matching to deal with same unbound node names in
--- different graphs.  It shows signs that it might be working now.
--- More testing is needed.
---
--- Revision 1.2  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
--- Revision 1.1  2003/03/12 23:00:43  graham
--- Graph model coded and working, except for graph isomorphism test.
---
− Swish/HaskellRDF/MapXsdInteger.hs 
@@ -1,96 +0,0 @@---------------------------------------------------------------------------------
---  $Id: MapXsdInteger.hs,v 1.1 2003/11/14 15:59:51 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  MapXsdInteger
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + ????
---
---  This module defines the datatytpe mapping and relation values
---  used for RDF dataype xsd:integer
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.MapXsdInteger
-    ( mapXsdInteger
-    )
-where
-
-import Swish.HaskellRDF.Datatype
-    ( DatatypeMap(..)
-    )
-
--import Swish.HaskellRDF.Dfa.Dfa
-    ( Re(..)
-    , matchRe
-    )
-
-------------------------------------------------------------
---  Implementation of DatatypeMap for xsd:integer
-------------------------------------------------------------
-
--- |mapXsdInteger contains functions that perform lexical-to-value
---  and value-to-canonical-lexical mappings for xsd:integer values
---
-mapXsdInteger :: DatatypeMap Integer
-mapXsdInteger = DatatypeMap
-    { -- mapL2V :: String -> Maybe Integer
-      mapL2V = \s -> case [ x
-                          | matchRe reInteger s
-                          , (x,t) <- reads $ skipPlus s
-                          , ("","") <- lex t
-                          ] of
-                    [] -> Nothing
-                    is -> Just $ head is
-      -- mapV2L :: Integer -> Maybe String
-    , mapV2L = Just . show
-    }
-
-skipPlus :: String -> String
-skipPlus ('+':s) = s
-skipPlus s       = s
-
-reInteger = ReCat [ReOpt (alt "+-"), digits1]
-    where
-        digits0 = ReStar digit
-        digits1 = RePlus digit
-        digit   = alt "0123456789"
-        alt cs  = ReOr $ map (\c -> ReTerm [c]) cs
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/MapXsdInteger.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: MapXsdInteger.hs,v $
--- Revision 1.1  2003/11/14 15:59:51  graham
--- Separate MapXsdInteger from RDFDatatypeXsdInteger.
---
− Swish/HaskellRDF/N3Formatter.hs 
@@ -1,695 +0,0 @@---------------------------------------------------------------------------------
---  $Id: N3Formatter.hs,v 1.23 2004/01/22 19:52:41 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  N3Formatter
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module implements a Notation 3 formatter (see [1], [2]),
---  for an RDFGraph value.
---
---
--- REFERENCES:
---
--- [1] http://www.w3.org/DesignIssues/Notation3.html
---     Tim Berners-Lee's design issues series notes and description
---
--- [2] http://www.w3.org/2000/10/swap/Primer.html
---     Notation 3 Primer by Sean Palmer
---
---
---  [[[TODO:]]]
---  (a) Initial prefix list to include nested formulae;
---      then don't need to update prefix list for these.
---  (b) blank nodes used just once, can be expanded inline using
---      [...] syntax.
---  (c) generate multi-line literals when appropriate
---  (d) more flexible terminator generation for formatted formulae
---      (for inline blank nodes.)
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.N3Formatter
-    ( formatGraphAsStringNl
-    , formatGraphAsString
-    , formatGraphAsShowS
-    , formatGraphIndent
-    , formatGraphDiag
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph, RDFLabel(..)
-    , NamespaceMap, RevNamespaceMap
-    , emptyNamespaceMap
-    , FormulaMap, emptyFormulaMap
-    , getArcs, labels
-    , setNamespaces, getNamespaces
-    , getFormulae
-    , emptyRDFGraph
-    )
-
-import Swish.HaskellRDF.GraphClass
-    ( Arc(..)
-    , arc
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..)
-    , LookupMap, emptyLookupMap, reverseLookupMap
-    , listLookupMap
-    , mapFind, mapFindMaybe, mapAdd, mapDelete, mapMerge
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..), getScopeURI )
-
-import Swish.HaskellUtils.ProcessURI
-    ( isAbsoluteURIRef )
-
-import Swish.HaskellRDF.Sort.QuickSort
-    ( stableQuickSort )
-
-import Data.Char
-    ( isDigit )
-
-import Data.List
-    ( groupBy )
-
-import Data.Maybe
-    ( Maybe(..), isJust, fromJust )
-
-----------------------------------------------------------------------
---  Ouptut string concatenation
-----------------------------------------------------------------------
---
---  Function puts uses the shows mechanism to avoid the cost of
---  quadratic string concatenation times.  (Use function composition to
---  concatenate strings thus reprersented.)
-
-puts :: String -> ShowS
-puts = showString
-
-----------------------------------------------------------------------
---  Graph formatting state monad
-----------------------------------------------------------------------
---
---  The graph to be formatted is carried as part of the formatting
---  state, so that decisions about what needs to be formatted can
---  themselves be based upon and reflected in the state (e.g. if a
---  decision is made to include a blank node inline, it can be removed
---  from the graph state that remains to be formatted).
-
-type SubjTree lb = [(lb,PredTree lb)]
-type PredTree lb = [(lb,[lb])]
-
-data Fgs = Fgs
-    { indent    :: String
-    , lineBreak :: Bool
-    , graph     :: RDFGraph
-    , subjs     :: SubjTree RDFLabel
-    , props     :: PredTree RDFLabel   -- for last subject selected
-    , objs      :: [RDFLabel]          -- for last property selected
-    , formAvail :: FormulaMap RDFLabel
-    , formQueue :: [(RDFLabel,RDFGraph)]
-    , nodeGenSt :: NodeGenState
-    , traceBuf  :: [String]
-    }
-
-emptyFgs :: NodeGenState -> Fgs
-emptyFgs ngs = Fgs
-    { indent    = "\n"
-    , lineBreak = False
-    , graph     = emptyRDFGraph
-    , subjs     = []
-    , props     = []
-    , objs      = []
-    , formAvail = emptyFormulaMap
-    , formQueue = []
-    , nodeGenSt = ngs
-    , traceBuf  = []
-    }
-
---  Node name generation state information that carries through
---  and is updated by nested formulae
-
-type NodeGenLookupMap = LookupMap (RDFLabel,Int)
-
-data NodeGenState = Ngs
-    { prefixes  :: NamespaceMap
-    , nodeMap   :: NodeGenLookupMap
-    , nodeGen   :: Int
-    }
-
-emptyNgs :: NodeGenState
-emptyNgs = Ngs
-    { prefixes  = emptyLookupMap
-    , nodeMap   = emptyLookupMap
-    , nodeGen   = 0
-    }
-
---  monad definition adapted from Simon Thompson's book, p410
---
---  Fgsm a is a "state transformer" on a state of type "Fgs",
---  which additionally returns a value of type 'a'.
-data Fgsm a = Fgsm ( Fgs -> (Fgs,a) )
-
-instance Monad Fgsm where
-    return res      = Fgsm (\fgs -> (fgs,res))
-    (Fgsm st) >>= f = Fgsm (\fgs ->
-        let (newfgs,res) = st fgs
-            (Fgsm st')   = f res
-        in
-            st' newfgs
-        )
-
-getFgs :: Fgsm Fgs
-getFgs = Fgsm (\fgs -> (fgs,fgs) )
-
-doTrace :: String -> Fgsm ()
-doTrace msg = Fgsm (\fgs -> (fgs {traceBuf=msg:(traceBuf fgs)},()) )
-
-getIndent :: Fgsm String
-getIndent = Fgsm (\fgs -> (fgs,indent fgs) )
-
-setIndent :: String -> Fgsm ()
-setIndent ind = Fgsm (\fgs -> (fgs {indent=ind},()) )
-
-getLineBreak :: Fgsm Bool
-getLineBreak = Fgsm (\fgs -> (fgs,lineBreak fgs) )
-
-setLineBreak :: Bool -> Fgsm ()
-setLineBreak brk = Fgsm (\fgs -> (fgs {lineBreak=brk},()) )
-
-getNgs :: Fgsm NodeGenState
-getNgs = Fgsm (\fgs -> (fgs,nodeGenSt fgs) )
-
-setNgs :: NodeGenState -> Fgsm ()
-setNgs ngs = Fgsm (\fgs -> (fgs { nodeGenSt = ngs },()) )
-
-getPrefixes :: Fgsm NamespaceMap
-getPrefixes = Fgsm (\fgs -> (fgs,prefixes (nodeGenSt fgs)) )
-
-queueFormula :: RDFLabel -> Fgsm ()
-queueFormula fn = Fgsm (\fgs ->
-    let fa = formAvail fgs
-        newState fv =
-            fgs { formAvail=mapDelete fa fn
-                , formQueue=(fn,fv):(formQueue fgs)
-                }
-    in
-        case (mapFindMaybe fn fa) of
-            Nothing -> (fgs,())
-            Just fv -> (newState fv,())
-    )
-
-moreFormulae :: Fgsm Bool
-moreFormulae =  Fgsm (\fgs -> (fgs,not $ null (formQueue fgs)) )
-
-nextFormula :: Fgsm (RDFLabel,RDFGraph)
-nextFormula =  Fgsm (\fgs ->
-    let (nf:fq) = (formQueue fgs) in (fgs {formQueue=fq},nf)
-    )
-
-----------------------------------------------------------------------
---  Define a top-level formatter function:
---  accepts a graph and returns a string
-----------------------------------------------------------------------
-
-formatGraphAsStringNl :: RDFGraph -> String
-formatGraphAsStringNl gr = formatGraphAsShowS gr "\n"
-
-formatGraphAsString :: RDFGraph -> String
-formatGraphAsString gr = formatGraphAsShowS gr ""
-
-formatGraphAsShowS :: RDFGraph -> ShowS
-formatGraphAsShowS gr = formatGraphIndent "\n" True gr
-{- old code:
-    where
-        (out,_,_,_) = formatGraphDiag gr
--}
-
-formatGraphIndent :: String -> Bool -> RDFGraph -> ShowS
-formatGraphIndent ind dopref gr = out
-    where
-        (_,out) = formatGraphDiag1 ind dopref emptyLookupMap gr
-
---  Format graph and return additional information
-formatGraphDiag ::
-    RDFGraph -> (ShowS,NodeGenLookupMap,Int,[String])
-formatGraphDiag gr = (out,nodeMap ngs,nodeGen ngs,traceBuf fgs)
-    where
-        (fgs,out) = formatGraphDiag1 "\n" True emptyLookupMap gr
-        ngs       = nodeGenSt fgs
-
---  Internal function starts with supplied prefix table and indent string,
---  and returns final state and formatted string.
---  This is provided for diagnostic access to the final state
-formatGraphDiag1 :: String -> Bool -> NamespaceMap -> RDFGraph -> (Fgs,ShowS)
-formatGraphDiag1 ind dopref pref gr = res where
-    Fgsm fg = formatGraph ind " ." False dopref gr  -- construct monad
-    ngs     = emptyNgs                  -- construct initial state
-                { prefixes=pref
-                , nodeGen=findMaxBnode gr
-                }
-    (_,res) = fg (emptyFgs ngs)         -- apply monad to state, pick result
-
-----------------------------------------------------------------------
---  Formatting as a monad-based computation
-----------------------------------------------------------------------
-
--- ind      is indentation string
--- end      is ending string to be placed after final statement
--- dobreak  is True if a line break is to be inserted at the start
--- dopref   is True if prefix strings are to be generated
---
-formatGraph :: String -> String -> Bool -> Bool -> RDFGraph -> Fgsm (Fgs,ShowS)
-formatGraph ind end dobreak dopref gr =
-    do  { setIndent ind
-        ; setLineBreak dobreak
-        ; setGraph gr
-        ; fp <- if dopref then
-                    formatPrefixes (getNamespaces gr)
-                else
-                    return $ puts ""
-        ; more <- moreSubjects
-        ; res  <- if more then do
-            { fr <- formatSubjects
-            ; return $ fp . fr . (puts end)
-            }
-          else return $ fp
-        ; fgs <- getFgs
-        ; return (fgs,res)
-        }
-
-formatPrefixes :: NamespaceMap -> Fgsm ShowS
-formatPrefixes pmap =
-    do  { let mls = map (pref . keyVal) (listLookupMap pmap)
-        ; ls <- sequence mls
-        ; return $ puts $ concat ls
-        }
-    where
-        pref (p,u) = nextLine $ "@prefix "++p++": <"++u++"> ."
-
---  The above function creates a list of 'Fgsm String' monads, then
---  uses 'sequence' to turn that to a single 'Fgsm [String]' and finally
---  concatenates them to a single string and uses 'puts' to return the
---  result as a 'Fgsm ShowS'.  Phew!
-
-formatSubjects :: Fgsm ShowS
-formatSubjects =
-    do  { sb    <- nextSubject
-        ; sbstr <- formatLabel sb
-        ; prstr <- formatProperties sb sbstr
-        ; fmstr <- formatFormulae ""
-        ; more  <- moreSubjects
-        ; if more then do
-            { fr <- formatSubjects
-            ; return $ (puts $ prstr ++ fmstr ++ " .") . fr
-            }
-          else return $ puts $ prstr ++ fmstr
-        }
-
-formatProperties :: RDFLabel -> String -> Fgsm String
-formatProperties sb sbstr =
-    do  { pr    <- nextProperty sb
-        ; prstr <- formatLabel pr
-        ; obstr <- formatObjects sb pr (sbstr++" "++prstr)
-        ; more  <- moreProperties
-        ; let sbindent = replicate (length sbstr) ' '
-        ; if more then do
-            { fr <- formatProperties sb sbindent
-            ; nl <- nextLine $ obstr ++ " ;"
-            ; return $ nl ++ fr
-            }
-          else nextLine $ obstr
-        }
-
-formatObjects :: RDFLabel -> RDFLabel -> String -> Fgsm String
-formatObjects sb pr prstr =
-    do  { ob    <- nextObject sb pr
-        ; obstr <- formatLabel ob
-        ; more  <- moreObjects
-        ; if more then do
-            { let prindent = replicate (length prstr) ' '
-            ; fr <- formatObjects sb pr prindent
-            ; nl <- nextLine $ prstr ++ " " ++ obstr ++ ","
-            ; return $ nl ++ fr
-            }
-          else return $ prstr ++ " " ++ obstr
-        }
-
-formatFormulae :: String -> Fgsm String
-formatFormulae fp =
-    do  { more  <- moreFormulae
-        ; if more then do
-            { fnlgr <- nextFormula
-            ; fnstr <- formatFormula fnlgr
-            ; formatFormulae $ fp ++ " ." ++ fnstr
-            }
-          else return $ fp
-        }
-
--- [[[TODO: use above pattern for subject/property/object loops?]]]
-
-formatFormula :: (RDFLabel,RDFGraph) -> Fgsm String
-formatFormula (fn,gr) =
-    do  { fnstr <- formatLabel fn
-        ; f1str <- nextLine $ fnstr ++ " :-"
-        ; f2str <- nextLine "    {"
-        ; ngs0  <- getNgs
-        ; ind   <- getIndent
-        ; let Fgsm grm = formatGraph (ind++"    ") "" True False
-                                     (setNamespaces emptyNamespaceMap gr)
-        ; let (fgs',(_,f3str)) = grm (emptyFgs ngs0)
-        ; setNgs (nodeGenSt fgs')
-        ; f4str <- nextLine "    }"
-        ; return $ f1str ++ f2str ++ (f3str f4str)
-        }
-
-----------------------------------------------------------------------
---  Formatting helpers
-----------------------------------------------------------------------
-
-setGraph        :: RDFGraph -> Fgsm ()
-setGraph gr =
-    Fgsm (\fgs ->
-        let ngs0 = (nodeGenSt fgs)
-            pre' = mapMerge (prefixes ngs0) (getNamespaces gr)
-            ngs' = ngs0 { prefixes=pre' }
-            fgs' = fgs  { graph     = gr
-                        , subjs     = arcTree $ getArcs gr
-                        , props     = []
-                        , objs      = []
-                        , formAvail = getFormulae gr
-                        , nodeGenSt = ngs'
-                        }
-        in (fgs',()) )
-
-moreSubjects    :: Fgsm Bool
-moreSubjects    = Fgsm (\fgs -> (fgs,not $ null (subjs fgs)))
-
-nextSubject     :: Fgsm RDFLabel
-nextSubject     =
-    Fgsm (\fgs ->
-        let sb:sbs = subjs fgs
-            fgs' = fgs  { subjs = sbs
-                        , props = snd sb
-                        , objs  = []
-                        }
-        in (fgs',fst sb) )
-
-
-moreProperties  :: Fgsm Bool
-moreProperties  = Fgsm (\fgs -> (fgs,not $ null (props fgs)))
-
-nextProperty    :: RDFLabel -> Fgsm RDFLabel
-nextProperty sb =
-    Fgsm (\fgs ->
-        let pr:prs = props fgs
-            fgs' = fgs  { props = prs
-                        , objs  = snd pr
-                        }
-        in (fgs',fst pr) )
-
-
-moreObjects     :: Fgsm Bool
-moreObjects     = Fgsm (\fgs -> (fgs,not $ null (objs fgs)))
-
-nextObject      :: RDFLabel -> RDFLabel -> Fgsm RDFLabel
-nextObject sb pr =
-    Fgsm (\fgs ->
-        let ob:obs = objs fgs
-            fgs'   = fgs { objs = obs }
-        in (fgs',ob) )
-
-nextLine        :: String -> Fgsm String
-nextLine str =
-    do  { ind <- getIndent
-        ; brk <- getLineBreak
-        ; if brk then
-            return $ ind++str
-          else
-            --  After first line, always insert line break
-            do  { setLineBreak True
-                ; return str
-                }
-        }
-
---  Format a label
---  Most labels are simply displayed as provided, but there are a
---  number of wrinkles to take care of here:
---  (a) blank nodes automatically allocated on input, with node
---      identifiers of the form of a digit string nnn.  These are
---      not syntactically valid, and are reassigned node identifiers
---      of the form _nnn, where nnn is chosen so that is does not
---      clash with any other identifier in the graph.
---  (b) URI nodes:  if possible, replace URI with qname,
---      else display as <uri>
---  (c) formula nodes (containing graphs).
---
---  [[[TODO:]]]
---  (d) blank nodes used just once, can be expanded inline using
---      [...] syntax.
---  (e) generate multi-line literals when appropriate
-
-formatLabel :: RDFLabel -> Fgsm String
-formatLabel lab@(Blank nodeid@(lnc:_)) =
-    do  { name <- formatNodeId lab
-        ; queueFormula lab
-        ; return name
-        }
-formatLabel lab@(Res sn) =
-    do  { pr <- getPrefixes
-        ; let nsuri  = getScopeURI sn
-        ; let local  = snLocal sn
-        ; let premap = reverseLookupMap pr :: RevNamespaceMap
-        ; let prefix = mapFindMaybe nsuri premap
-        ; let name   = if (isJust prefix)
-                        then fromJust prefix++":"++local
-                        else "<"++nsuri++local++">"
-        ; queueFormula lab
-        ; return name
-        }
-{-
-formatLabel lab@(Lit str typ) =
-    do  { return $ show lab
-        }
-formatLabel lab@(Var vid) =
-    do  { return $ show lab
-        }
--}
-formatLabel lab =
-    do  { return $ show lab
-        }
-
-formatNodeId :: RDFLabel -> Fgsm String
-formatNodeId lab@(Blank nodeid@(lnc:_)) =
-    if isDigit lnc then mapBlankNode lab else return $ show lab
-
-mapBlankNode :: RDFLabel -> Fgsm String
-mapBlankNode lab =
-    do  { ngs <- getNgs
-        ; let nmap = nodeMap ngs
-        ; let nnxt = (nodeGen ngs)
-        ; (nval,nnxt',nmap') <- case mapFind 0 lab nmap of
-            0 -> do { let nn = nnxt + 1
-                    ; let nm = mapAdd nmap (lab,nn)
-                    ; setNgs $ ngs { nodeGen=nn, nodeMap=nm }
-                    ; return (nn,nn,nm)
-                    }
-            n -> return $ (n,nnxt,nmap)
-        {- ; doTrace $ "Map node id: "++(show lab)
-                        ++", nval "++(show nval)
-                        ++", next "++(show nnxt')
-                        ++", nmap "++(show nmap') -}
-        ; return $ show $ Blank ('_':show nval)
-        }
-
-----------------------------------------------------------------------
---  Graph-related helper functions
-----------------------------------------------------------------------
-
---  Rearrange a list of arcs into a tree of pairs which group together
---  all statements for a single subject, sind similarly for multiple
---  objects of a common predicate.
-arcTree :: (Ord lb) => [Arc lb] -> SubjTree lb
-arcTree as = commonFstEq (commonFstEq id) $ map spopair $ stableQuickSort as
-    where
-        spopair (Arc s p o) = (s,(p,o))
-
-{-
-arcTree as = map spopair $ sort as
-    where
-        spopair (Arc s p o) = (s,[(p,[o])])
--}
-
---  Rearrange a list of pairs so that multiple occurrences of the first
---  are commoned up, and the supplied function is applied to each sublist
---  with common first elements to obtain the corresponding second value
-commonFstEq :: (Eq a) => ( [b] -> c ) -> [(a,b)] -> [(a,c)]
-commonFstEq f ps =
-    [ (fst $ head sps,f $ map snd sps) | sps <- groupBy fstEq ps ]
-    where
-        fstEq (f1,_) (f2,_) = f1 == f2
-
-{---- Diagnostic code for checking arcTree logic:
-testArcTree = (arcTree testArcTree1) == testArcTree2
-testArcTree1 =
-    [Arc "s1" "p11" "o111", Arc "s1" "p11" "o112"
-    ,Arc "s1" "p12" "o121", Arc "s1" "p12" "o122"
-    ,Arc "s2" "p21" "o211", Arc "s2" "p21" "o212"
-    ,Arc "s2" "p22" "o221", Arc "s2" "p22" "o222"
-    ]
-testArcTree2 =
-    [("s1",[("p11",["o111","o112"]),("p12",["o121","o122"])])
-    ,("s2",[("p21",["o211","o212"]),("p22",["o221","o222"])])
-    ]
--}--
-findMaxBnode    :: RDFGraph -> Int
-findMaxBnode gr =
-    maximum $
-    map getAutoBnodeIndex $
-    labels gr
-
-getAutoBnodeIndex   :: RDFLabel -> Int
-getAutoBnodeIndex (Blank ('_':lns)) = res where
-    -- cf. prelude definition of read s ...
-    res = case [x | (x,t) <- reads lns, ("","") <- lex t] of
-            [x] -> x
-            _   -> 0
-getAutoBnodeIndex _                   = 0
-
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/N3Formatter.hs,v $
--- $Author: graham $
--- $Revision: 1.23 $
--- $Log: N3Formatter.hs,v $
--- Revision 1.23  2004/01/22 19:52:41  graham
--- Rename module URI to avoid awkward clash with Haskell libraries
---
--- Revision 1.22  2004/01/09 12:57:08  graham
--- Remove space between perfix and ':' in @prefix declaractions,
--- for compatibility with new Notation 3 syntax (and Jena).
---
--- Revision 1.21  2004/01/09 12:49:39  graham
--- Remove superfluous PutS class.
---
--- Revision 1.20  2004/01/09 12:44:52  graham
--- Fix up N3Formatter to suppress final statement-terminating '.' in a formula,
--- for compatibility with the current Notation3 syntax.
---
--- Revision 1.19  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.18  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.17  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.16  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.15  2003/10/24 21:03:25  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.14  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.13  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.12  2003/06/25 21:16:52  graham
--- Reworked N3 formatting logic to support proof display.
--- Basic proof display is working.
---
--- Revision 1.11  2003/06/12 00:47:55  graham
--- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
---
--- Revision 1.10  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.9  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.8  2003/05/23 00:02:42  graham
--- Fixed blank node id generation bug in N3Formatter
---
--- Revision 1.7  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.6  2003/05/14 22:39:23  graham
--- Initial formatter tests all run OK.
--- The formatter could still use so,me improvement,
--- but it
--- passes the minimal round-tripping tests.
---
--- Revision 1.5  2003/05/14 19:38:32  graham
--- Simple formatter tests all working with reworked graph and lookup structures.
--- More complex formatter tests still to be coded.
---
--- Revision 1.4  2003/04/29 22:09:43  graham
--- Updated TODO notes
---
--- Revision 1.3  2003/04/29 22:07:10  graham
--- Some refactoring of N3 formatter.
--- N3 formatter now handles trivial cases.
--- More complex formatter test cases still to be developed.
---
--- Revision 1.2  2003/04/25 11:40:06  graham
--- Formatter compiles OK
---
--- Revision 1.1  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
− Swish/HaskellRDF/N3FormatterTest.hs 
@@ -1,1470 +0,0 @@---------------------------------------------------------------------------------
---  $Id: N3FormatterTest.hs,v 1.21 2004/01/09 12:57:08 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  N3FormatterTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module defines test cases for module Parse parsing functions.
---
---------------------------------------------------------------------------------
-
--- WNH module Swish.HaskellRDF.N3FormatterTest where
-
-import Swish.HaskellRDF.N3Formatter
-    ( formatGraphAsStringNl
-    , formatGraphAsString
-    , formatGraphDiag )
-
-import Swish.HaskellRDF.N3Parser
-    ( ParseResult(..)
-    , parseN3fromString
-    , parseTextFromString, parseAltFromString
-    , parseNameFromString, parsePrefixFromString
-    , parseAbsURIrefFromString, parseLexURIrefFromString
-    , parseURIref2FromString )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
-    , setArcs, getArcs, add, delete, extract, labels
-    , NamespaceMap, emptyNamespaceMap
-    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
-    , setNamespaces
-    , emptyRDFGraph, toRDFGraph
-      -- Export selected RDFLabel values
-    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
-    , res_rdfs_member
-    , res_rdfd_GeneralRestriction
-    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
-    , res_owl_sameAs
-    , res_operator_plus, res_operator_minus
-    , res_operator_slash, res_operator_star
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , makeNamespaceQName
-    , getQName, getScopedNameURI
-    , ScopedName(..)
-    , makeScopedName, makeQNameScopedName
-    , nullScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFC
-    , namespaceRDFO
-    , namespaceXSD
-    , namespaceXsdType
-    , namespaceOWL
-    , namespaceMATH
-    , namespaceLOG
-    , namespaceDAML
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil
-    , rdfs_member
-    , rdfd_GeneralRestriction
-    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
-    , owl_sameAs
-    , operator_plus, operator_minus, operator_slash, operator_star
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..)
-    , emptyLookupMap, makeLookupMap, listLookupMap )
-
-import Swish.HaskellRDF.GraphClass
-    ( Arc, arcSubj, arcPred, arcObj, arc )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(..) )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertEqual, runTestTT, runTestText, putTextToHandle )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-------------------------------------------------------------
---  Common test wrappers
-------------------------------------------------------------
-
-testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
-testLabelEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
-
-testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
-testGraphEq lab eq g1 g2 =
-    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-
-------------------------------------------------------------
---  Define some common values
-------------------------------------------------------------
-
-base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-
-qb1s1 = ScopedName base1 "s1"
-qb2s2 = ScopedName base2 "s2"
-qb3s3 = ScopedName base3 "s3"
-
-s1 = Res qb1s1  :: RDFLabel
-s2 = Res qb2s2  :: RDFLabel
-s3 = Res qb3s3  :: RDFLabel
-
-b1 = Blank "b1" :: RDFLabel
-b2 = Blank "b2" :: RDFLabel
-b3 = Blank "b3" :: RDFLabel
-b4 = Blank "b4" :: RDFLabel
-b5 = Blank "b5" :: RDFLabel
-b6 = Blank "b6" :: RDFLabel
-b7 = Blank "b7" :: RDFLabel
-b8 = Blank "b8" :: RDFLabel
-
-c1 = Blank "c1" :: RDFLabel
-c2 = Blank "c2" :: RDFLabel
-c3 = Blank "c3" :: RDFLabel
-c4 = Blank "c4" :: RDFLabel
-c5 = Blank "c5" :: RDFLabel
-c6 = Blank "c6" :: RDFLabel
-
-qb1p1  = ScopedName base1 "p1"
-qb2p2  = ScopedName base2 "p2"
-qb3p3  = ScopedName base3 "p3"
-qb2p21 = ScopedName base2 "p21"
-qb2p22 = ScopedName base2 "p22"
-qb2p23 = ScopedName base2 "p23"
-qb2p24 = ScopedName base2 "p24"
-qb2p25 = ScopedName base2 "p25"
-qb2p26 = ScopedName base2 "p26"
-
-p1  = Res qb1p1  :: RDFLabel
-p2  = Res qb2p2  :: RDFLabel
-p3  = Res qb3p3  :: RDFLabel
-p21 = Res qb2p21 :: RDFLabel
-p22 = Res qb2p22 :: RDFLabel
-p23 = Res qb2p23 :: RDFLabel
-p24 = Res qb2p24 :: RDFLabel
-p25 = Res qb2p25 :: RDFLabel
-p26 = Res qb2p26 :: RDFLabel
-
-qb1o1 = ScopedName base1 "o1"
-qb2o2 = ScopedName base2 "o2"
-qb3o3 = ScopedName base3 "o3"
-
-o1 = Res qb1o1 :: RDFLabel
-o2 = Res qb2o2 :: RDFLabel
-o3 = Res qb3o3 :: RDFLabel
-
-l1txt = "l1"
-l2txt = "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'"
-l3txt = "l3--\r\"'\\--\x0020\&--\x00A0\&--"
-l11txt = "lx11"
-l12txt = "lx12"
-l13txt = "lx13"
-l14txt = "lx14"
-
-l1  = Lit l1txt  Nothing    :: RDFLabel
-l2  = Lit l2txt  Nothing    :: RDFLabel
-l3  = Lit l3txt  Nothing    :: RDFLabel
-l11 = Lit l11txt Nothing    :: RDFLabel
-l12 = Lit l12txt Nothing    :: RDFLabel
-l13 = Lit l13txt Nothing    :: RDFLabel
-l14 = Lit l14txt Nothing    :: RDFLabel
-
-qb1f1 = ScopedName base1 "f1"
-qb2f2 = ScopedName base2 "f2"
-
-f1 = Res qb1f1 :: RDFLabel
-f2 = Res qb2f2 :: RDFLabel
-
-v1 = Var "var1" :: RDFLabel
-v2 = Var "var2" :: RDFLabel
-v3 = Var "var3" :: RDFLabel
-v4 = Var "var4" :: RDFLabel
-
-------------------------------------------------------------
---  Construct graphs for testing
-------------------------------------------------------------
-
-t01 = arc s1 p1 o1
-t02 = arc s2 p1 o2
-t03 = arc s3 p1 o3
-t04 = arc s1 p1 l1
-t05 = arc s2 p1 b1
-t06 = arc s3 p1 l2
-t07 = arc s3 p2 l3
-
-nslist = makeLookupMap
-    [ base1
-    , base2
-    , base3
-    , base4
-    ]
-
-g1np = NSGraph
-        { namespaces = emptyNamespaceMap
-        , formulae   = emptyFormulaMap
-        , statements = [t01]
-        }
-
-g1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01]
-        }
-
-g1b1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [b01]
-        }
-    where
-        b01 = arc b1 p1 o1
-
-g1b3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [b01]
-        }
-    where
-        b01 = arc b1 b2 b3
-
-g1a1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [a01]
-        }
-    where
-        a1  = Blank "1"  :: RDFLabel
-        a01 = arc a1 p1 o1
-
-g1l1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [l01]
-        }
-    where
-        l01 = arc s1 p1 l1
-
-g1l2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [l02]
-        }
-    where
-        l02 = arc s1 p1 l2
-
-
-g1f1 = NSGraph
-        { namespaces = nslist
-        , formulae   = formo1g1
-        , statements = [f01]
-        }
-    where
-        f01      = arc s1 p1 o1
-        formo1g1 = LookupMap [Formula o1 g1]
-
-
-g1f2 = NSGraph
-        { namespaces = nslist
-        , formulae   = formb2g1
-        , statements = [f02]
-        }
-    where
-        f02 = arc s1 p1 b2
-        formb2g1 = LookupMap [Formula b2 g1]
-
-g1f3 = NSGraph
-        { namespaces = nslist
-        , formulae   = formb3g1f2
-        , statements = [f02]
-        }
-    where
-        f02 = arc s1 p1 b3
-        formb3g1f2 = LookupMap [Formula b3 g1f2]
-
-----
-
-g2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03]
-        }
-
-g3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t04]
-        }
-
-g4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t05]
-        }
-
-g5 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05]
-        }
-
-g6 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t06]
-        }
-
-g7 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t07]
-        }
-
-pref_rdf = nsURI namespaceRDF
-pref_op  = nsURI namespaceRDFO
-pref_owl = nsURI namespaceOWL
-
-t801 = arc s1 res_rdf_type       o1
-t802 = arc s2 res_owl_sameAs     o2
-t803 = arc s3 res_operator_plus  o3
-t804 = arc s3 res_operator_minus o3
-t805 = arc s3 res_operator_star  o3
-t806 = arc s3 res_operator_slash o3
-t807 = arc o1 p1 s1
-t808 = arc s2 p1 o2
-t809 = arc s1 p2 o1
-t810 = arc o2 p2 s2
-
-g8 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t801,t802,t803,t804,t805,t806,t807,t808,t809,t810]
-        }
-
-g81 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t801,t802]
-        }
-
-g82 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t803,t804,t805,t806]
-        }
-
-g83 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t807,t808,t809,t810]
-        }
-
-t911 = arc s1 p1 o1
-t912 = arc s1 p1 o2
-t913 = arc s1 p2 o2
-t914 = arc s1 p2 o3
-t921 = arc s2 p1 o1
-t922 = arc s2 p1 o2
-t923 = arc s2 p1 o3
-t924 = arc s2 p1 l1
-t925 = arc s2 p2 o1
-t926 = arc s2 p2 o2
-t927 = arc s2 p2 o3
-t928 = arc s2 p2 l1
-
-g9 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t911,t912,t913,t914,
-                        t921,t922,t923,t924,
-                        t925,t926,t927,t928]
-        }
-
-t1011 = arc s1 p1 o1
-t1012 = arc o2 p1 s1
-t1013 = arc s1 p2 o2
-t1014 = arc o3 p2 s1
-t1021 = arc s2 p1 o1
-t1022 = arc s2 p1 o2
-t1023 = arc s2 p1 o3
-t1024 = arc s2 p1 l1
-t1025 = arc o1 p2 s2
-t1026 = arc o2 p2 s2
-t1027 = arc o3 p2 s2
--- t1028 = arc l1 p2 s2
-t1028 = arc s1 p2 s2
-
-g10 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1011,t1012,t1013,t1014,
-                        t1021,t1022,t1023,t1024,
-                        t1025,t1026,t1027,t1028 ]
-        }
-
-t1111 = arc s1 p1 v1
-t1112 = arc v2 p1 o1
-t1113 = arc v3 p1 v4
-
-g11 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1111,t1112,t1113]
-        }
-
-tx101 = arc b1 res_owl_sameAs s1
-tx102 = arc s2 res_owl_sameAs b2
-tx111 = arc b1 p1 o1
-tx112 = arc b1 p1 o2
-tx113 = arc b1 p2 o2
-tx114 = arc b1 p2 o3
-tx121 = arc b2 p1 o1
-tx122 = arc b2 p1 o2
-tx123 = arc b2 p1 o3
-tx124 = arc b2 p1 l1
-tx125 = arc b2 p2 o1
-tx126 = arc b2 p2 o2
-tx127 = arc b2 p2 o3
-tx128 = arc b2 p2 l1
-
-x1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx101,tx102,
-                        tx111,tx112,tx113,tx114,
-                        tx121,tx122,tx123,tx124,
-                        tx125,tx126,tx127,tx128]
-        }
-
-tx201 = arc b1 res_owl_sameAs s1
-tx202 = arc s2 res_owl_sameAs b2
-tx211 = arc b1 p1 o1
-tx212 = arc o2 p1 b1
-tx213 = arc b1 p2 o2
-tx214 = arc o3 p2 b1
-tx221 = arc b2 p1 o1
-tx222 = arc b2 p1 o2
-tx223 = arc b2 p1 o3
-tx224 = arc b2 p1 l1
-tx225 = arc o1 p2 b2
-tx226 = arc o2 p2 b2
-tx227 = arc o3 p2 b2
--- tx228 = arc l1 p2 b2
-
-x2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx201,tx202,
-                        tx211,tx212,tx213,tx214,
-                        tx221,tx222,tx223,tx224,
-                        tx225,tx226,tx227]
-        }
-
-tx311 = arc s1 p1 o1
-tx312 = arc o2 p1 s1
-tx313 = arc s1 p2 o2
-tx314 = arc o3 p2 s1
-tx321 = arc s2 p1 o1
-tx322 = arc s2 p1 o2
-tx323 = arc s2 p1 o3
-tx324 = arc s2 p1 l1
-tx325 = arc o1 p2 s2
-tx326 = arc o2 p2 s2
-tx327 = arc o3 p2 s2
--- tx328 = arc l1 p2 s2
-
-x3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx311,tx312,tx313,tx314,
-                        tx321,tx322,tx323,tx324,
-                        tx325,tx326,tx327]
-        }
-
-tx401 = arc s1 res_owl_sameAs b1
-tx402 = arc b1 res_rdf_first  o1
-tx403 = arc b1 res_rdf_rest   b2
-tx404 = arc b2 res_rdf_first  o2
-tx405 = arc b2 res_rdf_rest   b3
-tx406 = arc b3 res_rdf_first  o3
-tx407 = arc b3 res_rdf_rest   b4
-tx408 = arc b4 res_rdf_first  l1
-tx409 = arc b4 res_rdf_rest   res_rdf_nil
-
-x4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx401,tx402,tx403,tx404,
-                        tx405,tx406,tx407,tx408,
-                        tx409]
-        }
-
-tx501 = arc b1 res_owl_sameAs s1
-tx502 = arc b1 res_rdf_first  o1
-tx503 = arc b1 res_rdf_rest   b2
-tx504 = arc b2 res_rdf_first  o2
-tx505 = arc b2 res_rdf_rest   b3
-tx506 = arc b3 res_rdf_first  o3
-tx507 = arc b3 res_rdf_rest   b4
-tx508 = arc b4 res_rdf_first  l1
-tx509 = arc b4 res_rdf_rest   res_rdf_nil
-
-x5 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx501,tx502,tx503,tx504,
-                        tx505,tx506,tx507,tx508,
-                        tx509]
-        }
-
-tx601 = arc s1 res_rdf_first o1
-tx602 = arc s1 res_rdf_rest  b2
-tx603 = arc b2 res_rdf_first o2
-tx604 = arc b2 res_rdf_rest  b3
-tx605 = arc b3 res_rdf_first o3
-tx606 = arc b3 res_rdf_rest  b4
-tx607 = arc b4 res_rdf_first l1
-tx608 = arc b4 res_rdf_rest  res_rdf_nil
-
-x6 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx601,tx602,tx603,tx604,
-                        tx605,tx606,tx607,tx608]
-        }
-
-formb1g2 = LookupMap [Formula b1 g2]
-tx701    = arc b1 p2 f2
-x7       = NSGraph
-        { namespaces = nslist
-        , formulae   = formb1g2
-        , statements = [tx701]
-        }
-
-formf1g2 = LookupMap [Formula f1 g2]
-tx801    = arc f1 p2 f2
-x8       = NSGraph
-        { namespaces = nslist
-        , formulae   = formf1g2
-        , statements = [tx801]
-        }
-
-formf1g1 = LookupMap [Formula f1 g1]
-tx901 = arc f1 p2 f2
-
-x9 = NSGraph
-        { namespaces = nslist
-        , formulae   = formf1g1
-        , statements = [tx801]
-        }
-
---  Test allocation of bnodes carries over a nested formula
-tx1201 = arc s1 p1 b1
-tx1202 = arc b1 p1 o1
-tx1203 = arc b2 p2 f2
-tx1204 = arc s3 p3 b3
-tx1205 = arc b3 p3 o3
-tx1211 = arc s2 p2 b4
-tx1212 = arc b4 p2 o2
-x12fg  = NSGraph
-        { namespaces = emptyNamespaceMap
-        , formulae   = emptyFormulaMap
-        , statements = [tx1211,tx1212]
-        }
-x12f   = LookupMap [Formula b2 x12fg]
-x12    = NSGraph
-        { namespaces = nslist
-        , formulae   = x12f
-        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]
-        }
-
---  List of simple anon nodes
-tx1301 = arc s1 res_rdf_first b1
-tx1302 = arc s1 res_rdf_rest  c1
-tx1303 = arc c1 res_rdf_first b2
-tx1304 = arc c1 res_rdf_rest  c2
-tx1305 = arc c2 res_rdf_first b3
-tx1306 = arc c2 res_rdf_rest  res_rdf_nil
-tx1307 = arc b1 p1 o1
-tx1308 = arc b2 p1 o2
-tx1309 = arc b3 p1 o3
-
-x13    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,
-                        tx1307,tx1308,tx1309]
-        }
-
---  List of simple anon nodes using autogenerated bnodes
-b_1 = Blank "1" :: RDFLabel
-b_2 = Blank "2" :: RDFLabel
-b_3 = Blank "3" :: RDFLabel
-c_1 = Blank "4" :: RDFLabel
-c_2 = Blank "5" :: RDFLabel
-
-tx1301a = arc s1  res_rdf_first b_1
-tx1302a = arc s1  res_rdf_rest  c_1
-tx1303a = arc c_1 res_rdf_first b_2
-tx1304a = arc c_1 res_rdf_rest  c_2
-tx1305a = arc c_2 res_rdf_first b_3
-tx1306a = arc c_2 res_rdf_rest  res_rdf_nil
-tx1307a = arc b_1 p1 o1
-tx1308a = arc b_2 p1 o2
-tx1309a = arc b_3 p1 o3
-
-x13a = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1301a,tx1302a,tx1303a,tx1304a,tx1305a,tx1306a,
-                        tx1307a,tx1308a,tx1309a]
-        }
-
---  List of more complex anon nodes
-tx1401 = arc s1 res_rdf_first b1
-tx1402 = arc s1 res_rdf_rest  c1
-tx1403 = arc c1 res_rdf_first b2
-tx1404 = arc c1 res_rdf_rest  c2
-tx1405 = arc c2 res_rdf_first b3
-tx1406 = arc c2 res_rdf_rest  res_rdf_nil
-tx1407 = arc b1 p1 o1
-tx1408 = arc b1 p2 o1
-tx1409 = arc b2 p1 o2
-tx1410 = arc b2 p2 o2
-tx1411 = arc b3 p1 o3
-tx1412 = arc b3 p2 o3
-
-x14    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,
-                        tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]
-        }
-
---  List with nested list
-tx1501 = arc s1 res_rdf_first b1
-tx1502 = arc s1 res_rdf_rest  c1
-tx1503 = arc c1 res_rdf_first b2
-tx1504 = arc c1 res_rdf_rest  c2
-tx1505 = arc c2 res_rdf_first b3
-tx1506 = arc c2 res_rdf_rest  res_rdf_nil
-tx1507 = arc b1 p1 o1
-tx1508 = arc b2 p2 c3
-tx1509 = arc b3 p1 o3
-
-tx1521 = arc c3 res_rdf_first b4
-tx1522 = arc c3 res_rdf_rest  c4
-tx1523 = arc c4 res_rdf_first b5
-tx1524 = arc c4 res_rdf_rest  c5
-tx1525 = arc c5 res_rdf_first b6
-tx1526 = arc c5 res_rdf_rest  res_rdf_nil
-tx1527 = arc b4 p1 o1
-tx1528 = arc b5 p1 o2
-tx1529 = arc b6 p1 o3
-
-x15    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,
-                        tx1507,tx1508,tx1509,
-                        tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,
-                        tx1527,tx1528,tx1529]
-        }
-
-
-
---  More complex list with nested list
-tx1601 = arc s1 res_rdf_first b1
-tx1602 = arc s1 res_rdf_rest  c1
-tx1603 = arc c1 res_rdf_first b2
-tx1604 = arc c1 res_rdf_rest  c2
-tx1605 = arc c2 res_rdf_first b3
-tx1606 = arc c2 res_rdf_rest  res_rdf_nil
-tx1607 = arc b1 p1 o1
-tx1608 = arc b1 p2 o1
-tx1609 = arc b2 p2 c3
-tx1610 = arc b3 p1 o3
-tx1611 = arc b3 p2 o3
-
-tx1621 = arc c3 res_rdf_first b4
-tx1622 = arc c3 res_rdf_rest  c4
-tx1623 = arc c4 res_rdf_first b5
-tx1624 = arc c4 res_rdf_rest  c5
-tx1625 = arc c5 res_rdf_first b6
-tx1626 = arc c5 res_rdf_rest  res_rdf_nil
-tx1627 = arc b4 p1 o1
-tx1628 = arc b4 p2 o1
-tx1629 = arc b5 p1 o2
-tx1630 = arc b5 p2 o2
-tx1631 = arc b6 p1 o3
-tx1632 = arc b6 p2 o3
-
-x16    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,
-                        tx1607,tx1608,tx1609,tx1610,tx1611,
-                        tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,
-                        tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]
-        }
-
---  Troublesome example
-tx1701 = arc s1 res_rdf_type  o1
-tx1702 = arc s1 res_rdf_first b1
-tx1703 = arc s1 res_rdf_rest  c1
-tx1704 = arc c1 res_rdf_first b2
-tx1705 = arc c1 res_rdf_rest  res_rdf_nil
-
-tx1706 = arc b1 p21 o2
-tx1707 = arc b1 p22 c2
-
-tx1708 = arc b2 p24 o3
-tx1709 = arc b2 p25 l13
-
-tx1710 = arc c2 res_rdf_first b3
-tx1711 = arc c2 res_rdf_rest  c3
-tx1712 = arc c3 res_rdf_first l12
-tx1713 = arc c3 res_rdf_rest  res_rdf_nil
-
-tx1714 = arc b3 p23 l11
-
-x17    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1701,tx1702,tx1703,tx1704,tx1705,tx1706,
-                        tx1707,tx1708,tx1709,
-                        tx1710,tx1711,tx1712,tx1713,tx1714]
-        }
-
-------------------------------------------------------------
---  Trivial formatter tests
-------------------------------------------------------------
---
---  These are very basic tests that confirm that output for a
---  simple graph corresponds exactly to some supplied string.
-
-formatTest :: String -> RDFGraph -> String -> Test
-formatTest lab gr out =
-    TestList
-      [ TestCase ( assertEqual ("formatTest:"++lab) out res )
-      ]
-    where
-      res = formatGraphAsStringNl gr
-
-diagTest :: String -> RDFGraph -> String -> Test
-diagTest lab gr out =
-    TestList
-      [ TestCase ( assertEqual ("diag:text:"++lab) out (res "") )
-      , TestCase ( assertEqual ("diag:map:"++lab) emptyLookupMap nmap )
-      , TestCase ( assertEqual ("diag:gen:"++lab) 0 ngen )
-      , TestCase ( assertEqual ("diag:trc:"++lab) [] trc )
-      ]
-    where
-      (res,nmap,ngen,trc) = formatGraphDiag gr
-
-commonPrefixes =
-    "@prefix base1: <" ++ nsURI base1 ++ "> .\n" ++
-    "@prefix base2: <" ++ nsURI base2 ++ "> .\n" ++
-    "@prefix base3: <" ++ nsURI base3 ++ "> .\n" ++
-    "@prefix base4: <" ++ nsURI base4 ++ "> .\n"
-
---  Single statement using <uri> form
-simpleN3Graph_g1_01 =
-    "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> " ++
-    "<http://id.ninebynine.org/wip/2003/test/graph1/node#p1> " ++
-    "<http://id.ninebynine.org/wip/2003/test/graph1/node#o1> .\n"
-
---  Single statement using prefix:name form
-simpleN3Graph_g1_02 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 base1:o1 .\n"
-
---  Single blank node
-simpleN3Graph_g1_03 =
-    commonPrefixes ++
-    "_:b1 base1:p1 base1:o1 .\n"
-
---  Single auto-allocated blank node
-simpleN3Graph_g1_04 =
-    commonPrefixes ++
-    "_:_1 base1:p1 base1:o1 .\n"
-
---  Single literal object
-simpleN3Graph_g1_05 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 \"l1\" .\n"
-
---  Single multiline literal object
-simpleN3Graph_g1_06 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 \"l2-'\\\"line1\\\"'\\n\\nl2-'\\\"\\\"line2\\\"\\\"'\" .\n"
-
---  Single statement with formula node
-simpleN3Graph_g1_07 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 base1:o1 .\n"++
-    "base1:o1 :-\n"++
-    "    {\n"++
-    "    base1:s1 base1:p1 base1:o1\n"++
-    "    } .\n"
-
---  Single statement with formula blank node
-simpleN3Graph_g1_08 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 _:b2 .\n"++
-    "_:b2 :-\n"++
-    "    {\n"++
-    "    base1:s1 base1:p1 base1:o1\n"++
-    "    } .\n"
-
---  Three blank nodes (or is that blind mice?)
-simpleN3Graph_g1_09 =
-    commonPrefixes ++
-    "_:b1 _:b2 _:b3 .\n"
-
---  Simple nested foprmula case
-simpleN3Graph_g1_10 =
-    commonPrefixes ++
-    "base1:s1 base1:p1 _:b3 .\n"           ++
-    "_:b3 :-\n"                            ++
-    "    {\n"                              ++
-    "    base1:s1 base1:p1 _:b2 .\n"       ++
-    "    _:b2 :-\n"                        ++
-    "        {\n"                          ++
-    "        base1:s1 base1:p1 base1:o1\n" ++
-    "        }\n"                          ++
-    "    } .\n"
-
---  Simple troublesome case
-simpleN3Graph_x13a =
-    commonPrefixes ++
-    "base1:s1 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_1 ;\n"++
-    "         <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> _:_2 .\n"++
-    "_:_1 base1:p1 base1:o1 .\n"++
-    "_:_3 base1:p1 base2:o2 .\n"++
-    "_:_4 base1:p1 base3:o3 .\n"++
-    "_:_2 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_3 ;\n"++
-    "     <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> _:_5 .\n"++
-    "_:_5 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_4 ;\n"++
-    "     <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> <http://www.w3.org/1999/02/22-rdf-syntax-ns#nil> .\n"
-
-trivialTest01 = formatTest "trivialTest01" g1np simpleN3Graph_g1_01
-trivialTest02 = formatTest "trivialTest02" g1   simpleN3Graph_g1_02
-trivialTest03 = formatTest "trivialTest03" g1b1 simpleN3Graph_g1_03
-trivialTest04 = formatTest "trivialTest04" g1a1 simpleN3Graph_g1_04
-trivialTest05 = formatTest "trivialTest05" g1l1 simpleN3Graph_g1_05
-trivialTest06 = formatTest "trivialTest06" g1l2 simpleN3Graph_g1_06
-trivialTest07 = formatTest "trivialTest07" g1f1 simpleN3Graph_g1_07
-trivialTest08 = formatTest "trivialTest08" g1f2 simpleN3Graph_g1_08
-trivialTest09 = formatTest "trivialTest09" g1b3 simpleN3Graph_g1_09
-trivialTest10 = formatTest "trivialTest10" g1f3 simpleN3Graph_g1_10
-trivialTest13 = formatTest "trivialTest13" x13a simpleN3Graph_x13a
-
-diag13 = diagTest "trivialTest13" x13a simpleN3Graph_x13a
-
-trivialTestSuite = TestList
-  [ trivialTest01
-  , trivialTest02
-  , trivialTest03
-  , trivialTest04
-  , trivialTest05
-  , trivialTest06
-  , trivialTest07
-  , trivialTest08
-  , trivialTest09
-  , trivialTest10
-  , trivialTest13
-  ]
-
-------------------------------------------------------------
---  Parser tests to cross-check round-trip testing
-------------------------------------------------------------
-
-parseTest :: String -> String -> RDFGraph -> String -> Test
-parseTest lab inp gr er =
-    TestList
-      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )
-      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )
-      ]
-    where
-        (pe,pg) = case parseN3fromString inp of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-
-noError   = ""
-errorText = "*"
-
-parseTest01 = parseTest "01" simpleN3Graph_g1_01 g1np noError
-parseTest02 = parseTest "02" simpleN3Graph_g1_02 g1   noError
-parseTest03 = parseTest "03" simpleN3Graph_g1_03 g1b1 noError
-parseTest04 = parseTest "04" simpleN3Graph_g1_04 g1a1 noError
-parseTest05 = parseTest "05" simpleN3Graph_g1_05 g1l1 noError
-parseTest06 = parseTest "06" simpleN3Graph_g1_06 g1l2 noError
-parseTest07 = parseTest "07" simpleN3Graph_g1_07 g1f1 noError
-parseTest08 = parseTest "08" simpleN3Graph_g1_08 g1f2 noError
-
-parseTestSuite = TestList
-  [ parseTest01
-  , parseTest02
-  , parseTest03
-  , parseTest04
-  , parseTest05
-  , parseTest06
-  , parseTest07
-  , parseTest08
-  ]
-
-------------------------------------------------------------
---  Repeat above tests using parser and graph-comparison
-------------------------------------------------------------
---
---  This establishes a framework that will be used for
---  more complex tests that are less susceptible to trivial
---  formatting differences.  The idea is to generate output
---  that can be parsed to obtain an equivalent graph.
-
-roundTripTest :: String -> RDFGraph -> Test
-roundTripTest lab gr =
-    TestList
-      [ TestCase ( assertEqual ("RoundTrip:gr:"++lab) gr pg )
-      , TestCase ( assertEqual ("RoundTrip:er:"++lab) "" pe )
-      -- , TestCase ( assertEqual ("Formatted:"++lab) "" out )
-      ]
-    where
-        out     = formatGraphAsString gr
-        (pe,pg) = case parseN3fromString out of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-
---  Full round trip from graph source.  This test may pick up some errors
---  the bnode generation logic that are not tested by hand-assembled graph
---  data structures.
-fullRoundTripTest :: String -> String -> Test
-fullRoundTripTest lab grstr =
-    TestList
-      [ TestCase ( assertEqual ("FullRoundTrip:gr:"++lab) gr pg )
-      , TestCase ( assertEqual ("FullRoundTrip:er:"++lab) "" pe )
-      -- , TestCase ( assertEqual ("FullRoundTrip:"++lab) "" out )
-      ]
-    where
-        (ge,gr) = case parseN3fromString grstr of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-        out     = formatGraphAsString gr
-        (pe,pg) = case parseN3fromString out of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-
-roundTripTest01 = roundTripTest "01" g1np
-roundTripTest02 = roundTripTest "02" g1
-roundTripTest03 = roundTripTest "03" g1b1
-roundTripTest04 = roundTripTest "04" g1a1
-roundTripTest05 = roundTripTest "05" g1l1
-roundTripTest06 = roundTripTest "06" g1l2
-roundTripTest07 = roundTripTest "07" g1f1
-roundTripTest08 = roundTripTest "08" g1f2
-roundTripTest11 = fullRoundTripTest "11" simpleN3Graph_g1_01
-roundTripTest12 = fullRoundTripTest "12" simpleN3Graph_g1_02
-roundTripTest13 = fullRoundTripTest "13" simpleN3Graph_g1_03
-roundTripTest14 = fullRoundTripTest "14" simpleN3Graph_g1_04
-roundTripTest15 = fullRoundTripTest "15" simpleN3Graph_g1_05
-roundTripTest16 = fullRoundTripTest "16" simpleN3Graph_g1_06
-roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07
-roundTripTest18 = fullRoundTripTest "18" simpleN3Graph_g1_08
-
-roundTripTestSuite = TestList
-  [ roundTripTest01
-  , roundTripTest02
-  , roundTripTest03
-  , roundTripTest04
-  , roundTripTest05
-  , roundTripTest06
-  , roundTripTest07
-  , roundTripTest08
-  , roundTripTest11
-  , roundTripTest12
-  , roundTripTest13
-  , roundTripTest14
-  , roundTripTest15
-  , roundTripTest16
-  , roundTripTest17
-  , roundTripTest18
-  ]
-
-------------------------------------------------------------
---  Simple formatter tests
-------------------------------------------------------------
---
---  These are simple tests that format and re-parse a graph,
---  and make sure that the result graph compares the same as
---  the original.  Therefore, depends on a trusted parser and
---  graph compare function.
-
-simpleTest :: String -> RDFGraph -> Test
-simpleTest lab = roundTripTest ("SimpleTest:"++lab)
-
-simpleTest01 = simpleTest "01" g2
-simpleTest02 = simpleTest "02" g3
-simpleTest03 = simpleTest "03" g4
-simpleTest04 = simpleTest "04" g5
-simpleTest05 = simpleTest "05" g6
-simpleTest06 = simpleTest "06" g7
-simpleTest07 = simpleTest "07" g8
-simpleTest08 = simpleTest "08" g81
-simpleTest09 = simpleTest "09" g82
-simpleTest10 = simpleTest "10" g83
-simpleTest11 = simpleTest "11" g9
-simpleTest12 = simpleTest "12" g10
-simpleTest13 = simpleTest "13" g11
-
-simpleTestSuite = TestList
-  [ simpleTest01
-  , simpleTest02
-  , simpleTest03
-  , simpleTest04
-  , simpleTest05
-  , simpleTest06
-  , simpleTest07
-  , simpleTest08
-  , simpleTest09
-  , simpleTest10
-  , simpleTest11
-  , simpleTest12
-  , simpleTest13
-  ]
-
-------------------------------------------------------------
---  Exotic parser tests
-------------------------------------------------------------
---
---  These tests cover various forms of anonymous nodes
---  [...], lists and formulae. together with uses of ':-'
---
-
--- does a round-trip test starting with the
-exoticTest :: String -> RDFGraph -> Test
-exoticTest lab gr =
-    TestList
-      [ TestCase ( assertEqual ("ExoticTest:gr:"++lab) gr pg )
-      , TestCase ( assertEqual ("ExoticTest:er:"++lab) "" pe )
-      -- , TestCase ( assertEqual ("ExoticTest:"++lab)    "" out )
-      ]
-    where
-        out     = formatGraphAsString gr
-        (pe,pg) = case parseN3fromString out of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-
---  Simple anon nodes, with semicolons and commas
-exoticN3Graph_x1 =
-    commonPrefixes ++
-    " [ base1:p1 base1:o1 ; \n" ++
-    "   base1:p1 base2:o2 ; \n" ++
-    "   base2:p2 base2:o2 ; \n" ++
-    "   base2:p2 base3:o3 ] = base1:s1 . \n" ++
-    " base2:s2 = \n" ++
-    " [ base1:p1 base1:o1 , \n" ++
-    "   base2:o2 , \n" ++
-    "   base3:o3 , \n" ++
-    "   \"l1\"   ; \n" ++
-    "   base2:p2 base1:o1 , \n" ++
-    "            base2:o2 , \n" ++
-    "            base3:o3 , \n" ++
-    "            \"l1\"   ] . \n"
-
---  Simple anon nodes, with 'is ... of' and semicolons and commas
-exoticN3Graph_x2 =
-    commonPrefixes ++
-    " [ has base1:p1 of base1:o1 ; \n" ++
-    "   is  base1:p1 of base2:o2 ; \n" ++
-    "   has base2:p2 of base2:o2 ; \n" ++
-    "   is  base2:p2 of base3:o3 ] = base1:s1 . \n" ++
-    " base2:s2 = \n" ++
-    " [ has base1:p1 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ; \n" ++
-    "   is  base2:p2 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 ] . \n"
-    -- "                   \"l1\"   ] . \n"
-
---  Simple anon nodes, attached to identified node
-exoticN3Graph_x3 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    " [ has base1:p1 of base1:o1 ; \n" ++
-    "   is  base1:p1 of base2:o2 ; \n" ++
-    "   has base2:p2 of base2:o2 ; \n" ++
-    "   is  base2:p2 of base3:o3 ] . \n" ++
-    " base2:s2 :- \n" ++
-    " [ has base1:p1 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ; \n" ++
-    "   is  base2:p2 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 ] . \n"
-    -- "                   \"l1\"   ] . \n"
-
---  List nodes, with and without :-
-
-exoticN3Graph_x4 =
-    commonPrefixes ++
-    " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
-
-exoticN3Graph_x5 =
-    commonPrefixes ++
-    " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"
-
-exoticN3Graph_x6 =
-    commonPrefixes ++
-    " base1:s1 :- (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
-
---  Formula nodes, with and without :-
-
-exoticN3Graph_x7 =
-    commonPrefixes ++
-    " { base1:s1 base1:p1 base1:o1 .   \n" ++
-    "   base2:s2 base1:p1 base2:o2 .   \n" ++
-    "   base3:s3 base1:p1 base3:o3 . } \n" ++
-    " base2:p2 base2:f2 . "
-
-exoticN3Graph_x8 =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    " { base1:s1 base1:p1 base1:o1 .     \n" ++
-    "   base2:s2 base1:p1 base2:o2 .     \n" ++
-    "   base3:s3 base1:p1 base3:o3 . } ; \n" ++
-    " base2:p2 base2:f2 . "
-
-exoticN3Graph_x9 =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    " { base1:s1 base1:p1 base1:o1 . } ; \n" ++
-    " base2:p2 base2:f2 . "
-
---  Test allocation of bnodes over a nested formula
-exoticN3Graph_x12 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" ++
-    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++
-    "            base2:p2 base2:f2 .                \n" ++
-    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."
-
---  List of bnodes
-exoticN3Graph_x13 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1] \n" ++
-    "    [base1:p1 base2:o2] \n" ++
-    "    [base1:p1 base3:o3] ) .\n"
-
---  List of more complex bnodes
-exoticN3Graph_x14 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
-    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
-    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
-
---  List with nested list
-exoticN3Graph_x15 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1] \n"++
-    "    [base2:p2 \n" ++
-    "       ( [base1:p1 base1:o1] \n" ++
-    "         [base1:p1 base2:o2] \n" ++
-    "         [base1:p1 base3:o3] ) ] \n"++
-    "    [base1:p1 base3:o3] ) .\n"
-
---  More complex list with nested list
-exoticN3Graph_x16 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"++
-    "    [base2:p2 \n" ++
-    "       ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
-    "         [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
-    "         [base1:p1 base3:o3; base2:p2 base3:o3] ) ] \n"++
-    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
-
---  Troublesome example
-exoticN3Graph_x17 =
-    commonPrefixes ++
-    "base1:s1 a base1:o1 ; :- \n" ++
-    "  ( [ base2:p21 base2:o2  ;  \n" ++
-    "      base2:p22 ( [ base2:p23 \"lx11\" ] \"lx12\" ) ] \n" ++
-    "    [ base2:p24 base3:o3 ; base2:p25 \"lx13\" ] \n" ++
-    "  ) . \n"
-
---  Null prefixes
-exoticN3Graph_x18 =
-    commonPrefixes ++
-    "@prefix : <#> . " ++
-    ":s1 a :o1 ; :- \n" ++
-    "  ( [ :p21 :o2  ;  \n" ++
-    "      :p22 ( [ :p23 \"lx11\" ] \"lx12\" ) ] \n" ++
-    "    [ :p24 :o3 ; :p25 \"lx13\" ] \n" ++
-    "  ) . \n"
-
--- Check graph sources parse to expected values
-exoticParseTest01 = parseTest "exoticParseTest01" exoticN3Graph_x1 x1 noError
-exoticParseTest02 = parseTest "exoticParseTest02" exoticN3Graph_x2 x2 noError
-exoticParseTest03 = parseTest "exoticParseTest03" exoticN3Graph_x3 x3 noError
-exoticParseTest04 = parseTest "exoticParseTest04" exoticN3Graph_x4 x4 noError
-exoticParseTest05 = parseTest "exoticParseTest05" exoticN3Graph_x5 x5 noError
-exoticParseTest06 = parseTest "exoticParseTest06" exoticN3Graph_x6 x6 noError
-exoticParseTest07 = parseTest "exoticParseTest07" exoticN3Graph_x7 x7 noError
-exoticParseTest08 = parseTest "exoticParseTest08" exoticN3Graph_x8 x8 noError
-exoticParseTest09 = parseTest "exoticParseTest09" exoticN3Graph_x9 x9 noError
-exoticParseTest12 = parseTest "exoticParseTest12" exoticN3Graph_x12 x12 noError
-exoticParseTest13 = parseTest "exoticParseTest13" exoticN3Graph_x13 x13 noError
-exoticParseTest13a = parseTest "exoticParseTest13a" exoticN3Graph_x13 x13a noError
-exoticParseTest14 = parseTest "exoticParseTest14" exoticN3Graph_x14 x14 noError
-exoticParseTest15 = parseTest "exoticParseTest15" exoticN3Graph_x15 x15 noError
-exoticParseTest16 = parseTest "exoticParseTest16" exoticN3Graph_x16 x16 noError
-exoticParseTest17 = parseTest "exoticParseTest17" exoticN3Graph_x17 x17 noError
-
-exoticTest01 = exoticTest "01" x1
-exoticTest02 = exoticTest "02" x2
-exoticTest03 = exoticTest "03" x3
-exoticTest04 = exoticTest "04" x4
-exoticTest05 = exoticTest "05" x5
-exoticTest06 = exoticTest "06" x6
-exoticTest07 = exoticTest "07" x7
-exoticTest08 = exoticTest "08" x8
-exoticTest09 = exoticTest "09" x9
-exoticTest10 = testGraphEq  "exoticTest10" False x7 x8
-exoticTest11 = testGraphEq  "exoticTest11" False x8 x9
-exoticTest12 = exoticTest "12" x12
-exoticTest13 = exoticTest "13" x13
-exoticTest13a = exoticTest "13a" x13a
-exoticTest14 = exoticTest "14" x14
-exoticTest15 = exoticTest "15" x15
-exoticTest16 = exoticTest "16" x16
-exoticTest17 = exoticTest "17" x17
-
-exoticRoundTripTest01 = fullRoundTripTest "Exotic01" exoticN3Graph_x1
-exoticRoundTripTest02 = fullRoundTripTest "Exotic02" exoticN3Graph_x2
-exoticRoundTripTest03 = fullRoundTripTest "Exotic03" exoticN3Graph_x3
-exoticRoundTripTest04 = fullRoundTripTest "Exotic04" exoticN3Graph_x4
-exoticRoundTripTest05 = fullRoundTripTest "Exotic05" exoticN3Graph_x5
-exoticRoundTripTest06 = fullRoundTripTest "Exotic06" exoticN3Graph_x6
-exoticRoundTripTest07 = fullRoundTripTest "Exotic07" exoticN3Graph_x7
-exoticRoundTripTest08 = fullRoundTripTest "Exotic08" exoticN3Graph_x8
-exoticRoundTripTest09 = fullRoundTripTest "Exotic09" exoticN3Graph_x9
-exoticRoundTripTest12 = fullRoundTripTest "Exotic12" exoticN3Graph_x12
-exoticRoundTripTest13 = fullRoundTripTest "Exotic13" exoticN3Graph_x13
-exoticRoundTripTest14 = fullRoundTripTest "Exotic14" exoticN3Graph_x14
-exoticRoundTripTest15 = fullRoundTripTest "Exotic15" exoticN3Graph_x15
-exoticRoundTripTest16 = fullRoundTripTest "Exotic16" exoticN3Graph_x16
-exoticRoundTripTest17 = fullRoundTripTest "Exotic17" exoticN3Graph_x17
-exoticRoundTripTest18 = fullRoundTripTest "Exotic18" exoticN3Graph_x18
-
-exoticTestSuite = TestList
-  [ exoticParseTest01
-  , exoticParseTest02
-  , exoticParseTest03
-  , exoticParseTest04
-  , exoticParseTest05
-  , exoticParseTest06
-  , exoticParseTest07
-  , exoticParseTest08
-  , exoticParseTest09
-  , exoticParseTest12
-  , exoticParseTest13
-  , exoticParseTest13a
-  , exoticParseTest14
-  , exoticParseTest15
-  , exoticParseTest16
-  , exoticParseTest17
-  , exoticTest01
-  , exoticTest02
-  , exoticTest03
-  , exoticTest04
-  , exoticTest05
-  , exoticTest06
-  , exoticTest07
-  , exoticTest08
-  , exoticTest09
-  , exoticTest10
-  , exoticTest11
-  , exoticTest12
-  , exoticTest13
-  , exoticTest13a
-  , exoticTest14
-  , exoticTest15
-  , exoticTest16
-  , exoticTest17
-  , exoticRoundTripTest01
-  , exoticRoundTripTest02
-  , exoticRoundTripTest03
-  , exoticRoundTripTest04
-  , exoticRoundTripTest05
-  , exoticRoundTripTest06
-  , exoticRoundTripTest07
-  , exoticRoundTripTest08
-  , exoticRoundTripTest09
-  , exoticRoundTripTest12
-  , exoticRoundTripTest13
-  , exoticRoundTripTest14
-  , exoticRoundTripTest15
-  , exoticRoundTripTest16
-  , exoticRoundTripTest17
-  , exoticRoundTripTest18
-  ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ trivialTestSuite
-  , parseTestSuite
-  , roundTripTestSuite
-  , simpleTestSuite
-  , exoticTestSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/N3FormatterTest.hs,v $
--- $Author: graham $
--- $Revision: 1.21 $
--- $Log: N3FormatterTest.hs,v $
--- Revision 1.21  2004/01/09 12:57:08  graham
--- Remove space between perfix and ':' in @prefix declaractions,
--- for compatibility with new Notation 3 syntax (and Jena).
---
--- Revision 1.20  2004/01/09 12:44:52  graham
--- Fix up N3Formatter to suppress final statement-terminating '.' in a formula,
--- for compatibility with the current Notation3 syntax.
---
--- Revision 1.19  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.18  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.17  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.16  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.15  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.14  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.13  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.12  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.11  2003/07/01 14:18:57  graham
--- Allow blank node in predicate position.
--- Add parser and formatter test case for this.
---
--- Revision 1.10  2003/06/25 21:16:52  graham
--- Reworked N3 formatting logic to support proof display.
--- Basic proof display is working.
---
--- Revision 1.9  2003/06/12 00:47:55  graham
--- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
---
--- Revision 1.8  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.7  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.6  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.5  2003/05/23 00:02:42  graham
--- Fixed blank node id generation bug in N3Formatter
---
--- Revision 1.4  2003/05/14 22:39:23  graham
--- Initial formatter tests all run OK.
--- The formatter could still use so,me improvement,
--- but it
--- passes the minimal round-tripping tests.
---
--- Revision 1.3  2003/05/14 19:38:32  graham
--- Simple formatter tests all working with reworked graph and lookup structures.
--- More complex formatter tests still to be coded.
---
--- Revision 1.2  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.1  2003/04/30 12:14:08  graham
--- Add formetter test to CVS
--- Noted problem with RDFGraph structure: preparing to rework
---
---
− Swish/HaskellRDF/N3Parser.hs 
@@ -1,1104 +0,0 @@---------------------------------------------------------------------------------
---  $Id: N3Parser.hs,v 1.36 2004/01/22 19:52:41 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  N3Parser
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module implements a Notation 3 parser (see [1], [2]), returning a
---  new RDFGraph consisting of triples and namespace information parsed from
---  the supplied N3 input string, or an error indication.
---
---  Uses the Parsec monadic parser library.
---
---
--- REFERENCES:
---
--- [1] http://www.w3.org/DesignIssues/Notation3.html
---     Tim Berners-Lee's design issues series notes and description
---
--- [2] http://www.w3.org/2000/10/swap/Primer.html
---     Notation 3 Primer by Sean Palmer
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.N3Parser
-    ( ParseResult
-    , parseN3fromString
-    , parseAnyfromString
-    , parseTextFromString, parseAltFromString
-    , parseNameFromString, parsePrefixFromString
-    , parseAbsURIrefFromString, parseLexURIrefFromString, parseURIref2FromString
-    -- Exports for parsers that embed Notation3 in a bigger syntax
-    , N3Parser, N3State(..)
-    , whiteSpace, symbol, lexeme, eof, identStart, identLetter
-    , defaultPrefix, namedPrefix
-    , document, subgraph, uriRef2, varid, lexUriRef
-    , newBlankNode
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph, RDFLabel(..)
-    , NamespaceMap
-    , LookupFormula(..) 
-    , addArc 
-    , setFormula
-    , setNamespaces
-    , emptyRDFGraph
-    )
-
-import Swish.HaskellRDF.GraphClass
-    ( arc )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..)
-    , mapFind, mapReplace, mapReplaceOrAdd )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix 
-    , getScopedNameURI
-    , makeScopedName, makeUriScopedName
-    , nullScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFO
-    , namespaceOWL
-    , langName
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil
-    , owl_sameAs
-    , operator_plus, operator_minus, operator_slash, operator_star
-    , default_base
-    )
-
-import Swish.HaskellUtils.ProcessURI
-    ( isAbsoluteURIRef, isValidURIRef, absoluteUriPart )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(Error,Result) )
--import Swish.HaskellRDF.ParsecLanguage
-    ( emptyDef )
-
-import Text.ParserCombinators.Parsec
-
-import qualified Text.ParserCombinators.Parsec.Token as P
-
-import Data.Char
-    ( chr, digitToInt )
-
-
-----------------------------------------------------------------------
---  Set up token parsers
-----------------------------------------------------------------------
-
-pythonStyle =
-        emptyDef
-            { P.commentStart   = ""
-            , P.commentEnd     = ""
-            , P.commentLine    = "#"
-            , P.nestedComments = True
-            , P.identStart     = letter <|> char '_'      -- oneOf "_"
-            , P.identLetter    = alphaNum <|> char '_'
-            , P.reservedNames  = []
-            , P.reservedOpNames= []
-            , P.caseSensitive  = True
-            }
-
-lexer :: P.TokenParser N3State
-lexer = P.makeTokenParser pythonStyle
-
-whiteSpace = P.whiteSpace lexer
-symbol     = P.symbol     lexer
-lexeme     = P.lexeme     lexer
-
-identStart  = P.identStart  pythonStyle
-identLetter = P.identLetter pythonStyle
-
-----------------------------------------------------------------------
--- Define parser state and helper functions
-----------------------------------------------------------------------
-
---  N3 parser state
-data N3State = N3State
-        { graphState :: RDFGraph            -- Graph under construction
-        , thisNode   :: RDFLabel            -- current context node (aka 'this')
-        , prefixUris :: NamespaceMap        -- namespace prefix mapping table
-        , syntaxUris :: SpecialMap          -- special name mapping table
-        , nodeGen    :: Int                 -- blank node id generator
-        }
-
---  Type for special name lookup table
-type SpecialMap = LookupMap (String,ScopedName)
-
---  Functions to update N3State vector (use with Parsec updateState)
-setPrefix :: String -> String -> N3State -> N3State
-setPrefix pre uri st =  st { prefixUris=p' }
-    where
-        p'    = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)
-
---  Set name for special syntax element
-setSName :: String -> ScopedName -> N3State -> N3State
-setSName nam snam st =  st { syntaxUris=s' }
-    where
-        s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)
-setSUri :: String -> String -> N3State -> N3State
-setSUri nam suri = setSName nam (makeScopedName "" suri "")
-
---  Get name for special syntax element, default null
-getSName :: N3State -> String -> ScopedName
-getSName st nam =  mapFind nullScopedName nam (syntaxUris st)
-
-getSUri :: N3State -> String -> String
-getSUri st nam = getScopedNameURI $ getSName st nam
-
---  Lookup prefix in table and return URI or 'prefix:'
-mapPrefix :: NamespaceMap -> String -> String
-mapPrefix ps pre = mapFind (pre++":") pre ps
-
---  Functions to access state:
---  Map prefix to namespace
-getPrefixNs :: N3State -> String -> Namespace
-getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre)
-
---  Map ScopedName using prefix table
---  (Ignore URI in supplied ScopedName)
-getPrefixScopedName :: N3State -> ScopedName -> ScopedName
-getPrefixScopedName st snam = ScopedName (getPrefixNs st pre) loc
-    where
-        pre = getScopePrefix snam
-        loc = snLocal snam
-
---  Return function to update graph in N3 parser state,
---  using the supplied function of a graph
---  (use returned function with Parsec updateState)
-updateGraph :: ( RDFGraph -> RDFGraph ) -> ( N3State -> N3State )
-updateGraph f s = s { graphState = f (graphState s) }
-
---  Define default table of namespaces
-prefixTable =   [ namespaceRDF
-                , namespaceRDFS
-                , namespaceRDFD     -- datatypes
-                , namespaceRDFO     -- operators
-                , namespaceOWL
-                ]
-
---  Define default special-URI table
-specialTable :: [(String,ScopedName)]
-specialTable =  [ ( "a",         rdf_type       ),
-                  ( "equals",    owl_sameAs     ),
-                  ( "listfirst", rdf_first      ),
-                  ( "listrest",  rdf_rest       ),
-                  ( "listnull",  rdf_nil        ),
-                  ( "plus",      operator_plus  ),
-                  ( "minus",     operator_minus ),
-                  ( "slash",     operator_slash ),
-                  ( "star",      operator_star  ),
-                  ( "base",      default_base   ) ]
-
-----------------------------------------------------------------------
---  Define top-level parser function:
---  accepts a string and returns a graph or error
-----------------------------------------------------------------------
-
-type N3Parser a = GenParser Char N3State a
-
-type ParseResult = ErrorM RDFGraph -- PResult RDFGraph | PError String
-
-parseN3fromString :: String -> ParseResult
-parseN3fromString input =
-        case parseAnyfromString document Nothing input of
-            Left  err -> Error err
-            Right gr  -> Result gr
-
---  Function to supply initial context and parse supplied term
---
---  parser  is parser to apply
---  base    is base URI of the input, or Nothing to use default base value
---  input   is the input to be parsed
---
-parseAnyfromString :: N3Parser a -> Maybe String -> String -> (Either String a)
-parseAnyfromString parser base input =
-        let
-            pmap   = LookupMap prefixTable
-            smap   = LookupMap specialTable
-            bmap   = case base of
-                Nothing -> smap
-                Just bs -> mapReplace smap ("base",makeUriScopedName bs)
-            pstate = N3State
-                    { graphState = emptyRDFGraph
-                    , thisNode   = NoNode
-                    , prefixUris = pmap
-                    , syntaxUris = bmap
-                    , nodeGen    = 0
-                    }
-            result = runParser parser pstate "" input
-        in
-            case result of
-                Left  err -> Left  (show err)
-                Right res -> Right res
-
-newBlankNode :: N3Parser RDFLabel
-newBlankNode =
-        do  { s <- getState
-            ; let n = (nodeGen s) + 1
-            ; setState ( s { nodeGen = n } )
-            ; return (Blank (show n))
-            }
-
---  Test functions for selected element parsing
-
-parseTextFromString :: String -> String -> (Either String String)
-parseTextFromString s =
-    parseAnyfromString (string s) Nothing
-
-parseAltFromString :: String -> String -> String -> (Either String String)
-parseAltFromString s1 s2 =
-    parseAnyfromString ( (string s1) <|> (string s2) ) Nothing
-
-parseNameFromString :: String -> (Either String String)
-parseNameFromString =
-    parseAnyfromString name Nothing
-
-parsePrefixFromString :: String -> (Either String Namespace)
-parsePrefixFromString =
-    parseAnyfromString prefix Nothing
-
-parseAbsURIrefFromString :: String -> (Either String String)
-parseAbsURIrefFromString =
-    parseAnyfromString absUriRef Nothing
-
-parseLexURIrefFromString :: String -> (Either String String)
-parseLexURIrefFromString =
-    parseAnyfromString lexUriRef Nothing
-
-parseURIref2FromString :: String -> (Either String ScopedName)
-parseURIref2FromString =
-    parseAnyfromString uriRef2 Nothing
-
-----------------------------------------------------------------------
---  Syntax productions
-----------------------------------------------------------------------
-
---  document         = directive* statement-list
-
-document :: N3Parser RDFGraph
-document =
-        do  { whiteSpace
-            ; many directive
-            ; statements
-            ; eof
-            ; s <- getState
-            ; return $ setNamespaces (prefixUris s) (graphState s)
-            }
-
-
---  directive        = "@prefix" prefix ":" uriRef2 "."   // Namespace declaration
---                   | "@prefix" ":" uriRef2 "."          // Default namespace
---                   | "@equivalence" uriRef2 "."         // Alternative to daml:equivalent
---                   | "@listfirst" uriRef2 "."           // Alternative to n3:first
---                   | "@listrest"  uriRef2 "."           // Alternative to n3:rest
---                   | "@listnull"  uriRef2 "."           // Alternative to n3:null
---                   | "@plus"  uriRef2 "."               // Alternative to operator:plus
---                   | "@minus" uriRef2 "."               // Alternative to operator:minus
---                   | "@slash" uriRef2 "."               // Alternative to operator:slash
---                   | "@star"  uriRef2 "."               // Alternative to operator:star
---                   | "@base"  uriRef2 "."               // Base URI for relative URIs.
-
-directive :: N3Parser ()
-directive =
-        do  { try $ symbol "@prefix"
-            ; ( defaultPrefix <|> namedPrefix )
-            }
-    <|>
-        do  { string "@"    -- not lexeme
-            ; syntaxUri
-            }
-    <?>
-        "directive"
-
-defaultPrefix :: N3Parser ()
-defaultPrefix =
-        do  { symbol ":"
-            ; u <- uriRef2
-            ; symbol "."
-            ; updateState $ setPrefix "" (getScopedNameURI u)
-            }
-
-namedPrefix :: N3Parser ()
-namedPrefix =
-        do  { n <- name
-            ; symbol ":"
-            ; u <- uriRef2
-            ; symbol "."
-            ; updateState $ setPrefix n (getScopedNameURI u)
-            }
-
-syntaxUri :: N3Parser ()
-syntaxUri =
-        do  { s <- uriName
-            ; u <- uriRef2
-            ; symbol "."
-            ; updateState $ setSUri s (getScopedNameURI u)
-            }
-
-uriName :: N3Parser String
-uriName =
-        (try $ symbol "equivalence")
-    <|> (try $ symbol "listfirst")
-    <|> (try $ symbol "listrest")
-    <|> (try $ symbol "listnull")
-    <|> (try $ symbol "plus")
-    <|> (try $ symbol "minus")
-    <|> (try $ symbol "slash")
-    <|> (try $ symbol "star")
-    <|> (try $ symbol "base")
-    <?> "special URI directive"
-
-
---  statements       = [ statement ( "." statement )* ]
---
---  statement        = subject property-list
---
---  properties       = [ property ( ";" property )* ]
---
---  New statements are added to the user state graph
-
-statements :: N3Parser ()
-statements =
-        do  { sepEndBy1 statement (symbol ".")
-            ; return ()
-            }
-
-statement :: N3Parser ()
-statement =
-        do  { subj <- subject
-            ; optional $ properties subj
-            }
-
-properties :: RDFLabel -> N3Parser ()
-properties subj =
-        do  { sepBy1 (property subj) (symbol ";")
-            ; return ()
-            }
-
-
---  property         = verb object-list
---                   | ":-" anon-node           // Creates anon-node aongside the current node
---  verb             = ">-" prop "->"           // has 'prop' of
---                   | "<-" prop "<-"           // is  'prop' of
---                   | operator                 // has operator:'operator' of (???)
---                   | prop                     // has 'prop' of -- shorthand
---                   | "has" prop "of"          // has 'prop' of
---                   | "is" prop "of"           // is  'prop' of
---                   | "a"                      // has rdf:type of
---                   | "="                      // has daml:equivalent of
---
---  subj    is the subject node for these properties.
---
---  New statements are added to the graph in the parser's user state.
-
-property :: RDFLabel -> N3Parser ()
-property subj =
-    do  { (prop,swap) <- verb
-        ; objects subj prop swap
-        }
-    <|>
-    do  { symbol ":-"
-        ; anonNode subj
-        ; return ()
-        }
-
-verb :: N3Parser (RDFLabel,Bool)
-verb =  do  { p <- prop ;                              return (p,False) }
-    <|> do  { p <- operator ;                          return (p,False) }
-    <|> do  { symbol ">-"  ; p <- prop ; symbol "->" ; return (p,False) }
-    <|> do  { symbol "<-"  ; p <- prop ; symbol "<-" ; return (p,True) }
-    <|> do  { symbol "has" ; p <- prop ; symbol "of" ; return (p,False) }
-    <|> do  { symbol "is"  ; p <- prop ; symbol "of" ; return (p,True) }
-    <|> do  { symbol "a"
-            ; lab <- operatorLabel rdf_type
-            ; return (lab,False)
-            }
-    <|> do  { symbol "="
-            ; lab <- operatorLabel owl_sameAs
-            ; return (lab,False)
-            }
-    <?> "property"
-
-
---  objects          = object
---                   | object "," object-list
---
---  subj    is the subject node for the new statements,
---  prop    is the property node for the new statements.
---  swap    is true if the subject/object values in the resulting statement
---          are to be swapped (for "is <prop> of", etc.)
---
---  New statements are added to the graph in the parser's user state
-
-objects :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
-objects subj prop swap =
-        do  { sepBy1 (object subj prop swap) (symbol ",")
-            ; return ()
-            }
-
---  anonNode         = "[" property-list "]"    // Something with given properties
---                   | "{" statement-list "}"   // List of statements as resource
---                   | "(" node-list ")"        // Construct list with
---                                              //   rdf:first, rdf:rest, rdf:nil
---
---  subj    is the subject node with which the new anonymous node is equated,
---
---  The anonymous node value is returned by this parser (which is often the same
---  as the supplied subject node, but not always).
---
---  New statements are added to the graph in the parser's user state
---  (in the case of a formula, a new graph and parser are created, and
---  the graph arcs are added to this new graph).
-
-anonNode :: RDFLabel -> N3Parser RDFLabel
-anonNode subj =
-        do  { symbol "[" ; properties subj ; symbol "]" ; return subj }
-    <|> do  { symbol "{" ; form <- formula  subj ; symbol "}" ; return form }
-    <|> do  { symbol "(" ; list <- nodeList subj ; symbol ")" ; return list }
-    <?> "anon node (\"[\", \"(\" or \"{\")"
-
---  This method allows a statement list to be parsed as a subgraph
---  whose value is associated with the supplied node of the current
---  graph.
-
-formula :: RDFLabel -> N3Parser RDFLabel
-formula subj =
-        do  { subgr <- subgraph subj
-            ; updateState $ updateGraph
-                          $ setFormula (Formula subj subgr)
-            ; return subj
-            }
-
-subgraph :: RDFLabel -> N3Parser RDFGraph
-subgraph this =
-        do  { pstate <- getState
-            ; let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }
-            ; setState fstate       -- switch new state into parser
-            ; statements            -- parse statements of formula
-            ; fstate' <- getState
-            ; let nstate = pstate { nodeGen = (nodeGen fstate') }
-            ; setState nstate       -- swap back state, with updated nodeGen
-            ; return (graphState fstate')
-            }
-
---  prop             = uri-ref2
---                   | varid
---
---  Returns URI value as a Node
-
-prop :: N3Parser RDFLabel
-prop = nodeid <|> varid <|> uriNode
-
-
---  operator         = "+"                      // >- operator:plus ->
---                   | "-"                      // >- operator:minus ->
---                   | "/"                      // >- operator:slash ->
---                   | "*"                      // >- operator:star->
---
---  If matched, the operator is returned as a node value.
-
-operator :: N3Parser RDFLabel
-operator =
-        do  { symbol "+" ; operatorLabel operator_plus  }
-    <|> do  { symbol "-" ; operatorLabel operator_minus }
-    <|> do  { symbol "*" ; operatorLabel operator_star  }
-    <|> do  { symbol "/" ; operatorLabel operator_slash }
-    <?> ""
-
-operatorLabel :: ScopedName -> N3Parser RDFLabel
-operatorLabel snam =
-        do  { s <- getState
-            ; return $ Res (getPrefixScopedName s snam)
-            }
-
---  subject          = node
-
-subject :: N3Parser RDFLabel
-subject = node
-
-
---  object           = litNode
---
---  This production adds a new triple to the graph state,
---  using the supplied subject and propert values.
---  If swap is True, the subject and object positions are
---  swapped.
-
-object :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
-object subj prop swap =
-        do  { o <- litNode
-            ; if swap then (addStatement o prop subj)
-                      else (addStatement subj prop o)
-            }
-
--- Add statement to graph in N3 parser state
-
-addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> N3Parser ()
-addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))
-
-
---  nodeList         = litNode*
---
---  subj    is the node from which the list is linked.
---
---  Returns the supplied head of list or Nil node allocated.
---
---  Link first element of link to list head, scan rest of list,
---  and return the list head;  otherwise return a node rdf_null.
---
---  This slightly convoluted pattern is to deal with two different
---  occurrences of a list node:
---    <node> :- ( l1, l2, ... )
---      Here, <node> (the supplied subj) is the listhead.
---    <node> prop ( l1, l2, ... )
---      Here, the a new blank is supplied as subj to be the listhead.
---  In either case, if the list is non-empty, the supplied subj
---  is returned.  But if the list is empty, a rdf_null node is returned.
---  In the second case, the invoking production must use the returned
---  value.
-
-nodeList :: RDFLabel -> N3Parser RDFLabel
-nodeList subj =
-        do  { val   <- litNode
-            ; first <- operatorLabel rdf_first
-            ; addStatement subj first val
-            ; nodeList1 subj
-            ; return subj
-            }
-    <|> do  { nil   <- operatorLabel rdf_nil
-            ; return nil
-            }
-    <?> "Node or ')'"
-
-nodeList1 :: RDFLabel -> N3Parser ()
-nodeList1 prev =
-        do  { val   <- litNode
-            ; lnk   <- newBlankNode
-            ; first <- operatorLabel rdf_first
-            ; rest  <- operatorLabel rdf_rest
-            ; addStatement lnk  first val
-            ; addStatement prev rest  lnk
-            ; nodeList1 lnk
-            }
-    <|> do  { nil   <- operatorLabel rdf_nil
-            ; rest  <- operatorLabel rdf_rest
-            ; addStatement prev rest nil
-            }
-    <?> "Node or ')'"
-
-
---  lit-node         = node
---                   | str-node [ "@" lang ] [ "^^" uriRef2 ]
---  str-node         = '"' constant-value '"'
---                   | '"""' constant value '"""'   // Including single or double occurences of
---                                                  //   quotes and/or newlines
---
---  Returns a new node value.
-
-litNode :: N3Parser RDFLabel
-litNode =
-        node
-    <|> do  { s <- strNode
-            ; t <- litTypeOrLang
-            ; return $ Lit s t
-            }
-    <?> "URI, blank node or literal"
-
-strNode :: N3Parser String
-strNode =
-        tripleQuoteString
-    <|> singleQuoteString
-
-
-litTypeOrLang :: N3Parser (Maybe ScopedName)
-litTypeOrLang =
-        langTag
-    <|> typeUri
-    <|> return Nothing
-    <?> "'@tag' (language tag) or '^^name' (datatype URI)"
-
-langTag :: N3Parser (Maybe ScopedName)
-langTag =
-        do  { string "@"
-            ; l <- name -- name1 letter
-            ; return $ Just (langName l)
-            }
-    <?> "'@tag' (language tag)"
-
-typeUri :: N3Parser (Maybe ScopedName)
-typeUri =
-        do  { string "^^"
-            ; u <- uriRef2
-            ; return $ Just u
-            }
-    <?> "'^^name' (datatype URI)"
-
---  node             = nodeid
---                   | varid
---                   | uri-ref2
---                   | anon-node
---
---  nodeid           = "_:" name
---
---  varid            = "?" name
---
---  Returns a new node value.
-
-node :: N3Parser RDFLabel
-node =  nodeid
-    <|> varid
-    <|> uriNode
-    <|> do  { n <- newBlankNode
-            ; anonNode n
-            }
-    <?> "URI or blank node"
-
---  Identified blank node in input
---
---  Note that automatically generated blank node identifiers start with
---  a digit, where input node identifiers start with a letter, so there
---  can be no clash.  Care is needed when serializing a graph to ensure
---  that future clashes are avoided.
-
-nodeid :: N3Parser RDFLabel
--- nodeid = lexeme nodeid1
-nodeid =
-    do  { string "_:"
-        ; n <- name
-        ; return (Blank n)
-        }
-
---  variable identifier
-
-varid :: N3Parser RDFLabel
-varid = do  { string "?"
-            ; n <- name
-            ; return (Var n)
-            }
-
---  uriNode          = qname
---                   | "<" URI-reference ">"
---                   | "this"
-
-uriNode :: N3Parser RDFLabel
-uriNode =
-        do  { sn <- uriRef2 ;
-            ; return ( Res sn )
-            }
-    <|>
-        do  { string "this"
-            ; s <- getState
-            ; return ( thisNode s )
-            }
-    <?> "URI node"
-
-
---  uriRef2          = qname
---                   | ":" local-name
---                   | "<" URI-reference ">"
---  qname            = prefix ":" local-name
---
---  prefix           = name                         // Namespace prefix
---
---  local-name       = name                         // Local name (namespace qualified)
---
---  name             = alpha alphanumeric*
---
---  alpha            = "a"-"z"
---                   | "A"-"Z"
---                   | "_"
---
---  alphanumeric     = alpha
---                   | "0"-"9"
---
---  URI-reference    = (conforming to syntax in RFC2396)
---
---  uriRef2 returns a ScopedName.
-
-uriRef2 :: N3Parser ScopedName
-uriRef2 = ( lexeme $ try uriRef2a )
-    <?> "URI or QName"
-
-uriRef2a =
-        do  { ns    <- prefix
-            ; string ":"
-            ; local <- localname
-            ; return $ ScopedName ns local
-            }
-    <|>
-        do  { string ":"
-            ; ns    <- defaultprefix
-            ; local <- localname
-            ; return $ ScopedName ns local
-            }
-    <|>
-        do  { u <- absUriRef
-            ; return $ makeUriScopedName u
-            }
-    <?> "URI or QName"
-
-prefix :: N3Parser Namespace
-prefix =
-        do  { pref <- prefixname
-            ; st   <- getState
-            ; return (getPrefixNs st pref)   -- map prefix to namespace
-            }
-
-defaultprefix :: N3Parser Namespace
-defaultprefix =
-        do  { st <- getState
-            ; return (getPrefixNs st "")
-            }
-
-name :: N3Parser String
-name =  lexeme $ name1 identStart
-
-prefixname :: N3Parser String
-prefixname =  name1 identStart
-
-localname :: N3Parser String
-localname =  lexeme $ name1 identLetter
-
---  'name1' is a name without following whitespace
---  initChar is a parser for the first character
-name1 :: N3Parser Char -> N3Parser String
-name1 initChar =
-    do  { c  <- initChar
-        ; cs <- many identLetter
-        ; return (c:cs)
-        }
-    <?> "identifier"
-
-
-----------------------------------------------------------------------
--- Lexical support
-----------------------------------------------------------------------
---
--- The following code adapted from ParsecToken,
--- modified to handle different escape conventions and triple-quoted strings
---      \c
---      \uhhhh
---      \Uhhhhhhhh
---
--- Regular single-quoted string -- cannot be split over line breaks
-
-singleQuoteString :: N3Parser String
-singleQuoteString =
-    lexeme
-    (   between (char '"') (char '"' <?> "end of string (\")") anyStringChars
-    <?> "literal string" )
-
-anyStringChars =
-        do  { str <- many stringChar
-            ; return (foldr (maybe id (:)) "" str)
-            }
-
--- Triple-quoted string -- may include line breaks, '"' or '""'.
-tripleQuoteString :: N3Parser String
-tripleQuoteString =
-    lexeme
-    (   do  { str <- between (try $ string "\"\"\"")
-                             (string "\"\"\"" <?> "end of string (\"\"\")")
-                             (many tripleQuoteSubstring)
-            ; return (foldr (++) "" str)
-            }
-    <?> "triple-quoted literal string" )
-
--- Match non-quote substring or one or two quote characters
-tripleQuoteSubstring :: N3Parser String
-tripleQuoteSubstring =
-        tripleQuoteSubstring1
-    <|> try sqTripleQuoteSubstring1
-    <|> try dqTripleQuoteSubstring1
-
-dqTripleQuoteSubstring1 =
-        do  { string "\"\""
-            ; s <- tripleQuoteSubstring1
-            ; return $ "\"\""++s
-            }
-
-sqTripleQuoteSubstring1 =
-        do  { char '"'
-            ; s <- tripleQuoteSubstring1
-            ; return $ "\""++s
-            }
-
--- match at least one non-quote character in a triple-quoted string
-tripleQuoteSubstring1 :: N3Parser String
-tripleQuoteSubstring1 =
-        do  { str <- many1 tripleQuoteStringChar
-            ; return $ foldr (maybe id (:)) "" str
-            }
-
-tripleQuoteStringChar :: CharParser st (Maybe Char)
-tripleQuoteStringChar =
-            stringChar
-    <|> do  { (string "\n")
-            ; return $ Just '\n'
-            }
-
-stringChar :: CharParser st (Maybe Char)
-stringChar      =
-        do  { c <- stringLetter
-            ; return $ Just c
-            }
-    <|> stringEscape
-    <?> "string character"
-
-stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c >= '\032'))
-
-stringEscape    =
-        do  { char '\\'
-            ; do { esc <- escapeCode; return (Just esc) }
-            }
-
--- escape codes
-escapeCode      = charEsc <|> charUCS2 <|> charUCS4 <?> "escape code"
-
--- \c
-charEsc         = choice (map parseEsc escMap)
-                where
-                    parseEsc (c,code) = do { char c; return code }
-                    escMap            = zip ("nrt\\\"\'") ("\n\r\t\\\"\'")
-
--- \uhhhh
-charUCS2        =
-        do  { char 'u'
-            ; n <- numberFW 16 hexDigit 4 0
-            ; return $ chr n
-            }
-
--- \Uhhhhhhhh
-charUCS4        =
-        do  { char 'U'
-            ; n <- numberFW 16 hexDigit 8 0
-            ; return $ chr n
-            }
-
--- parse fixed-width number:
-numberFW :: Int -> CharParser st Char -> Int -> Int -> CharParser st Int
-numberFW base baseDigit 0     val = return val
-numberFW base baseDigit width val =
-        do  { d <- baseDigit
-            ; numberFW base baseDigit (width-1) ((val*base) + (digitToInt d))
-            }
-
-
-----------------------------------------------------------------------
---  Parse a URI reference from the input
---  The result returned has absolute form;  relative URIs are resolved
---  relative to the current base prefix (set using "@base").
---
---  [[[TODO:  rework the URI parser to use the Parsec library]]]
-
---  lexeme version
-lexUriRef :: N3Parser String
-lexUriRef = lexeme absUriRef
-
-absUriRef :: N3Parser String
-absUriRef =
-        do  { u <- between (char '<') (char '>' <?> "end of URI '>'") anyUriChars
-            ; if (isAbsoluteURIRef u)
-              then (return u)
-              else
-              if (isValidURIRef u)
-              then
-                do  { s <- getState
-                    ; (return $ absoluteUriPart (getSUri s "base") u)
-                    }
-              else (fail ("Invalid URI: <"++u++">"))
-            }
-
-anyUriChars :: N3Parser String
-anyUriChars = many uriChar
-
-uriChar :: N3Parser Char
-uriChar =
-        alphaNum
-    <|> oneOf "[];?:@&=+$,-_.!~*'()%//#"
-    <?> "URI character"
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/N3Parser.hs,v $
--- $Author: graham $
--- $Revision: 1.36 $
--- $Log: N3Parser.hs,v $
--- Revision 1.36  2004/01/22 19:52:41  graham
--- Rename module URI to avoid awkward clash with Haskell libraries
---
--- Revision 1.35  2004/01/09 11:23:54  graham
--- Fix up N3Parser so that the final statement-terminating '.' in a formula
--- or file is optional.
---
--- Revision 1.34  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.33  2003/12/20 12:53:40  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.32  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.31  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.30  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.29  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.28  2003/12/03 17:07:23  graham
--- Replace occurrences of QName in N3Parser with ScopedName.
---
--- Revision 1.27  2003/12/03 15:57:00  graham
--- Use common parser wrapper function for all parsing.
--- (This will also be used for Swish script parsing.)
---
--- Revision 1.26  2003/12/03 15:42:09  graham
--- Eliminate special return type in favour of ErrorM
---
--- Revision 1.25  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.24  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.23  2003/10/24 21:02:42  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.22  2003/10/09 16:26:31  graham
--- Added parser support for literal language tags and datatypes.
--- (Language tags are names, not strictly per RFC3066)
---
--- Revision 1.21  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.20  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.19  2003/07/01 14:18:57  graham
--- Allow blank node in predicate position.
--- Add parser and formatter test case for this.
---
--- Revision 1.18  2003/06/19 19:48:03  graham
--- Allow variable id in predicate position
---
--- Revision 1.17  2003/06/12 00:47:56  graham
--- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
---
--- Revision 1.16  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.15  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.14  2003/05/22 15:16:39  graham
--- Added additional parser test cases for lists
---
--- Revision 1.13  2003/05/21 13:55:13  graham
--- N3 parser now handles relative URIs and default prefixes.
--- (Still need to figure better default base URI handling; i.e. current document)
---
--- Revision 1.12  2003/05/21 13:34:13  graham
--- Various N3 parser bug fixes.
--- Need to fix handling of :name terms.
---
--- Revision 1.11  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.10  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.9  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.8  2003/04/17 00:35:38  graham
--- Added module N3ParserTest
--- N3parser is mostly working
--- Formulae remain to test
---
--- Revision 1.7  2003/04/15 21:40:54  graham
--- N3Parser compiles
--- Some small changes to RDFGraph
--- Added some QName methods
---
--- Revision 1.6  2003/04/11 17:38:34  graham
--- Rename GraphLookupMap to LookupMap
---
--- Revision 1.5  2003/04/10 20:08:39  graham
--- Reorganized RDFGraph naming (RDFGraphTest OK)
--- Progressing N3Parser
---
--- Revision 1.4  2003/03/12 23:00:43  graham
--- Graph model coded and working, except for graph isomorphism test.
---
--- Revision 1.3  2003/03/12 13:41:59  graham
--- N3 parser initial coding done.
--- Graph not yet implemented.
---
--- Revision 1.2  2003/03/08 17:28:45  graham
--- Added string literal parsing code
---
--- Revision 1.1  2003/03/07 22:53:38  graham
--- Started on N3 parser in Haskell
− Swish/HaskellRDF/N3ParserTest.hs 
@@ -1,1373 +0,0 @@---------------------------------------------------------------------------------
---  $Id: N3ParserTest.hs,v 1.25 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  N3ParserTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module contains test cases for module N3Parses.
---
---------------------------------------------------------------------------------
-
---  WNH RIP OUT module Swish.HaskellRDF.N3ParserTest where
-
-import Swish.HaskellRDF.N3Parser
-    ( ParseResult(..)
-    , parseN3fromString
-    , parseTextFromString, parseAltFromString
-    , parseNameFromString, parsePrefixFromString
-    , parseAbsURIrefFromString, parseLexURIrefFromString
-    , parseURIref2FromString
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
-    -- LookupNamespace(..), Namespace
-    , NamespaceMap, emptyNamespaceMap
-    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
-    , setArcs, getArcs, add, delete, extract, labels
-    , setNamespaces
-    , emptyRDFGraph, toRDFGraph
-      -- Export selected RDFLabel values
-    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
-    , res_rdfs_member
-    , res_rdfd_GeneralRestriction
-    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
-    , res_owl_sameAs
-    , res_operator_plus, res_operator_minus
-    , res_operator_slash, res_operator_star
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , makeNamespaceQName
-    , nullNamespace
-    , getQName, getScopedNameURI
-    , ScopedName(..)
-    , makeScopedName, makeQNameScopedName
-    , nullScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFC
-    , namespaceRDFO
-    , namespaceXSD
-    , namespaceXsdType
-    , namespaceOWL
-    , namespaceMATH
-    , namespaceLOG
-    , namespaceDAML
-    , namespaceLang, langName
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
-    , rdfs_member
-    , rdfd_GeneralRestriction
-    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
-    , owl_sameAs
-    , operator_plus, operator_minus, operator_slash, operator_star
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..)
-    , mapFind, mapFindMaybe )
-
-import Swish.HaskellRDF.GraphClass
-    ( Arc, arcSubj, arcPred, arcObj, arc )
-
-import Swish.HaskellUtils.QName
-    ( QName(..) )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(..) )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertEqual, runTestTT, runTestText, putTextToHandle )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-------------------------------------------------------------
---  Common values
-------------------------------------------------------------
-
-pref_rdf = nsURI namespaceRDF
-pref_op  = nsURI namespaceRDFO
-pref_owl = nsURI namespaceOWL
-
-------------------------------------------------------------
---  Generic item parsing test wrapper
-------------------------------------------------------------
-
-type ParseFromString a = String -> (Either String a)
-
-parseItemTest :: (Eq a, Show a) => ParseFromString a -> a
-                 -> String -> String -> a -> String -> Test
-parseItemTest ifroms def lab inp val err =
-    TestList
-      [ TestCase ( assertEqual ("parseItemError:"++lab) fixerr pe )
-      , TestCase ( assertEqual ("parseItemValue:"++lab) val pv )
-      ]
-    where
-        (pe,pv) = case ifroms inp of
-            Left  e -> (e,def)
-            Right v -> (noError,v)
-        fixerr = if err /= noError then pe else noError
-
-noError   = ""
-errorText = "*"
-
-------------------------------------------------------------
---  Common test wrappers
-------------------------------------------------------------
-
-testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
-testLabelEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
-
-testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
-testGraphEq lab eq g1 g2 =
-    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-
-parseTest :: String -> String -> RDFGraph -> String -> Test
-parseTest lab inp gr er =
-    TestList
-      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )
-      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )
-      ]
-    where
-        (pe,pg) = case parseN3fromString inp of
-            Result g -> ("",g)
-            Error  s -> (s,emptyRDFGraph)
-
-------------------------------------------------------------
---  Test simple character parsing
-------------------------------------------------------------
-
-parseCharTest :: String -> String
-                 -> String -> String -> String -> Test
-parseCharTest c = parseItemTest (parseTextFromString c) ""
-
-parseAltTest :: String -> String
-                -> String -> String -> String -> String -> Test
-parseAltTest c1 c2 = parseItemTest (parseAltFromString c1 c2) ""
-
-charInp01 = ":"
-char01    = ":"
-
-charInp02 = "<>"
-char02    = "<>"
-
-charInp03 = "<="
-
-parseCharTest01 = parseCharTest char01
-                    "parseCharTest01" charInp01 char01 noError
-parseCharTest02 = parseCharTest char02
-                    "parseCharTest02" charInp02 char02 noError
-parseCharTest03 = parseAltTest char01 char02
-                    "parseCharTest03" charInp01 char01 noError
-parseCharTest04 = parseAltTest char01 char02
-                    "parseCharTest04" charInp02 char02 noError
-parseCharTest05 = parseAltTest char01 char02
-                    "parseCharTest04" charInp03 "" errorText
-
-charTestSuite = TestList
-  [ parseCharTest01
-  , parseCharTest02
-  , parseCharTest03
-  , parseCharTest04
-  , parseCharTest05
-  ]
-
-------------------------------------------------------------
---  Test simple name parsing
-------------------------------------------------------------
-
-parseNameTest :: String -> String -> String -> String -> Test
-parseNameTest = parseItemTest parseNameFromString ""
-
-nameInp01 = "name"
-name01    = "name"
-
-nameInp02 = "rdf"
-name02    = "rdf"
-
-parseNameTest01 = parseNameTest "parseNameTest01" nameInp01 name01 ""
-parseNameTest02 = parseNameTest "parseNameTest02" nameInp02 name02 ""
-
-nameTestSuite = TestList
-  [ parseNameTest01
-  , parseNameTest02
-  ]
-
-------------------------------------------------------------
---  Test simple prefix parsing
-------------------------------------------------------------
-
-parsePrefixTest :: String -> String -> Namespace -> String -> Test
-parsePrefixTest = parseItemTest parsePrefixFromString nullNamespace
-
-prefixInp01 = "pref"
-prefix01    = Namespace "pref" "pref:"
-
-prefixInp02 = "rdf"
-prefix02    = Namespace "rdf" pref_rdf
-
-parsePrefixTest01 = parsePrefixTest "parsePrefixTest01" prefixInp01 prefix01 ""
-parsePrefixTest02 = parsePrefixTest "parsePrefixTest02" prefixInp02 prefix02 ""
-
-prefixTestSuite = TestList
-  [ parsePrefixTest01
-  , parsePrefixTest02
-  ]
-
-------------------------------------------------------------
---  Test absolute URIref parsing
-------------------------------------------------------------
-
-parseAbsUriRefTest :: String -> String -> String -> String -> Test
-parseAbsUriRefTest = parseItemTest parseAbsURIrefFromString ""
-
-parseLexUriRefTest :: String -> String -> String -> String -> Test
-parseLexUriRefTest = parseItemTest parseLexURIrefFromString ""
-
-absUriRefInp01  = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>"
-absUriRefInp01s = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type> "
-absUriRef01     = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
-
-absUriRefInp02  = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"
-absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "
-absUriRef02     = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
-
-parseAbsUriRefTest01 = parseAbsUriRefTest "parseAbsUriRefTest01" absUriRefInp01 absUriRef01 ""
-parseAbsUriRefTest02 = parseAbsUriRefTest "parseAbsUriRefTest02" absUriRefInp02 absUriRef02 ""
-parseAbsUriRefTest03 = parseLexUriRefTest "parseAbsUriRefTest03" absUriRefInp01s absUriRef01 ""
-parseAbsUriRefTest04 = parseLexUriRefTest "parseAbsUriRefTest04" absUriRefInp02s absUriRef02 ""
-
-absUriRefTestSuite = TestList
-  [ parseAbsUriRefTest01
-  , parseAbsUriRefTest02
-  , parseAbsUriRefTest03
-  , parseAbsUriRefTest04
-  ]
-
-
-------------------------------------------------------------
---  Test simple URIref parsing
-------------------------------------------------------------
-
-parseUriRef2Test :: String -> String -> ScopedName -> String -> Test
-parseUriRef2Test = parseItemTest parseURIref2FromString nullScopedName
-
-uriRef01 = "rdf:type "
-sname01  = ScopedName namespaceRDF "type"
-
-uriRef02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "
-sname02  =
-    makeScopedName "" "http://id.ninebynine.org/wip/2003/test/graph1/node#" "s1"
-
-parseUriRef2Test01 = parseUriRef2Test "parseUriRef2Test01" uriRef01 sname01 ""
-parseUriRef2Test02 = parseUriRef2Test "parseUriRef2Test02" uriRef02 sname02 ""
-
-uriRef2TestSuite = TestList
-  [ parseUriRef2Test01
-  , parseUriRef2Test02
-  ]
-
-------------------------------------------------------------
---  Define some common values
-------------------------------------------------------------
-
-base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node/"
-base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node#"
-base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-
-qb1s1 = ScopedName base1 "s1"
-qb2s2 = ScopedName base2 "s2"
-qb3s3 = ScopedName base3 "s3"
-
-s1 = Res qb1s1  :: RDFLabel
-s2 = Res qb2s2  :: RDFLabel
-s3 = Res qb3s3  :: RDFLabel
-
-b1 = Blank "b1" :: RDFLabel
-b2 = Blank "b2" :: RDFLabel
-b3 = Blank "b3" :: RDFLabel
-b4 = Blank "b4" :: RDFLabel
-b5 = Blank "b5" :: RDFLabel
-b6 = Blank "b6" :: RDFLabel
-b7 = Blank "b7" :: RDFLabel
-b8 = Blank "b8" :: RDFLabel
-
-c1 = Blank "c1" :: RDFLabel
-c2 = Blank "c2" :: RDFLabel
-c3 = Blank "c3" :: RDFLabel
-c4 = Blank "c4" :: RDFLabel
-c5 = Blank "c5" :: RDFLabel
-c6 = Blank "c6" :: RDFLabel
-
-qb1p1 = ScopedName base1 "p1"
-qb2p2 = ScopedName base2 "p2"
-qb3p3 = ScopedName base3 "p3"
-
-p1 = Res qb1p1  :: RDFLabel
-p2 = Res qb2p2  :: RDFLabel
-p3 = Res qb3p3  :: RDFLabel
-
-qb1o1 = ScopedName base1 "o1"
-qb2o2 = ScopedName base2 "o2"
-qb3o3 = ScopedName base3 "o3"
-
-o1 = Res qb1o1  :: RDFLabel
-o2 = Res qb2o2  :: RDFLabel
-o3 = Res qb3o3  :: RDFLabel
-
-l1 = Lit "l1"  Nothing :: RDFLabel
-l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing :: RDFLabel
-l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing    :: RDFLabel
-
-lfr    = Lit "chat"          (Just $ langName "fr")     :: RDFLabel
-lxml   = Lit "<br/>"         (Just rdf_XMLLiteral )     :: RDFLabel
-lfrxml = Lit "<em>chat</em>" (Just rdf_XMLLiteral )     :: RDFLabel -- was: lang "fr"
-
-qb1f1 = ScopedName base1 "f1"
-qb2f2 = ScopedName base2 "f2"
-
-f1 = Res qb1f1  :: RDFLabel
-f2 = Res qb2f2  :: RDFLabel
-
-v1 = Var "var1" :: RDFLabel
-v2 = Var "var2" :: RDFLabel
-v3 = Var "var3" :: RDFLabel
-v4 = Var "var4" :: RDFLabel
-
-------------------------------------------------------------
---  Construct graphs for testing
-------------------------------------------------------------
-
-t01  = arc s1 p1 o1
-t01b = arc b1 b2 b3
-t02  = arc s2 p1 o2
-t03  = arc s3 p1 o3
-t04  = arc s1 p1 l1
-t05  = arc s2 p1 b1
-t06  = arc s3 p1 l2
-t07  = arc s3 p2 l3
-
-makeNewPrefixNamespace :: (String,Namespace) -> Namespace
-makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)
-
-nslist = LookupMap $ map makeNewPrefixNamespace
-    [ ("base1",base1)
-    , ("base2",base2)
-    , ("base3",base3)
-    , ("base4",base4)
-    ]
-
-g1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01]
-        }
-
-g1b = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01b]
-        }
-
-g2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03]
-        }
-
-g3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t04]
-        }
-
-g4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t05]
-        }
-
-g5 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05]
-        }
-
-g6 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t06]
-        }
-
-g7 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t07]
-        }
-
-t801 = arc s1 res_rdf_type       o1
-t802 = arc s2 res_owl_sameAs     o2
-t803 = arc s3 res_operator_plus  o3
-t804 = arc s3 res_operator_minus o3
-t805 = arc s3 res_operator_star  o3
-t806 = arc s3 res_operator_slash o3
-t807 = arc o1 p1 s1
-t808 = arc s2 p1 o2
-t809 = arc s1 p2 o1
-t810 = arc o2 p2 s2
-
-g8 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t801,t802,t803,t804,t805,t806,t807,t808,t809,t810]
-        }
-
-g81 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t801,t802]
-        }
-
-g82 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t803,t804,t805,t806]
-        }
-
-g83 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t807,t808,t809,t810]
-        }
-
-t911 = arc s1 p1 o1
-t912 = arc s1 p1 o2
-t913 = arc s1 p2 o2
-t914 = arc s1 p2 o3
-t921 = arc s2 p1 o1
-t922 = arc s2 p1 o2
-t923 = arc s2 p1 o3
-t924 = arc s2 p1 l1
-t925 = arc s2 p2 o1
-t926 = arc s2 p2 o2
-t927 = arc s2 p2 o3
-t928 = arc s2 p2 l1
-
-g9 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t911,t912,t913,t914,
-                        t921,t922,t923,t924,
-                        t925,t926,t927,t928]
-        }
-
-t1011 = arc s1 p1 o1
-t1012 = arc o2 p1 s1
-t1013 = arc s1 p2 o2
-t1014 = arc o3 p2 s1
-t1021 = arc s2 p1 o1
-t1022 = arc s2 p1 o2
-t1023 = arc s2 p1 o3
-t1024 = arc s2 p1 l1
-t1025 = arc o1 p2 s2
-t1026 = arc o2 p2 s2
-t1027 = arc o3 p2 s2
-t1028 = arc l1 p2 s2
-
-g10 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1011,t1012,t1013,t1014,
-                        t1021,t1022,t1023,t1024,
-                        t1025,t1026,t1027,t1028]
-        }
-
-t1111 = arc s1 p1 v1
-t1112 = arc v2 p1 o1
-t1113 = arc v3 p1 v4
-
-g11 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1111,t1112,t1113]
-        }
-
-t1211 = arc b1 p1 o1
-t1221 = arc b2 res_rdf_first v1
-t1222 = arc b2 res_rdf_rest  b3
-t1223 = arc b3 res_rdf_first v2
-t1224 = arc b3 res_rdf_rest  res_rdf_nil
-
-g12 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1211,t1221,t1222,t1223,t1224]
-        }
-
-t1711 = arc s1 p1 lfr
-t1722 = arc s2 p2 lxml
-t1733 = arc s3 p3 lfrxml
-
-g17 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t1711,t1722,t1733]
-        }
-
-tx101 = arc b1 res_owl_sameAs s1
-tx102 = arc s2 res_owl_sameAs b2
-tx111 = arc b1 p1 o1
-tx112 = arc b1 p1 o2
-tx113 = arc b1 p2 o2
-tx114 = arc b1 p2 o3
-tx121 = arc b2 p1 o1
-tx122 = arc b2 p1 o2
-tx123 = arc b2 p1 o3
-tx124 = arc b2 p1 l1
-tx125 = arc b2 p2 o1
-tx126 = arc b2 p2 o2
-tx127 = arc b2 p2 o3
-tx128 = arc b2 p2 l1
-
-x1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx101,tx102,
-                        tx111,tx112,tx113,tx114,
-                        tx121,tx122,tx123,tx124,
-                        tx125,tx126,tx127,tx128]
-        }
-
-tx201 = arc b1 res_owl_sameAs s1
-tx202 = arc s2 res_owl_sameAs b2
-tx211 = arc b1 p1 o1
-tx212 = arc o2 p1 b1
-tx213 = arc b1 p2 o2
-tx214 = arc o3 p2 b1
-tx221 = arc b2 p1 o1
-tx222 = arc b2 p1 o2
-tx223 = arc b2 p1 o3
-tx224 = arc b2 p1 l1
-tx225 = arc o1 p2 b2
-tx226 = arc o2 p2 b2
-tx227 = arc o3 p2 b2
-tx228 = arc l1 p2 b2
-
-x2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx201,tx202,
-                        tx211,tx212,tx213,tx214,
-                        tx221,tx222,tx223,tx224,
-                        tx225,tx226,tx227,tx228]
-        }
-
-tx311 = arc s1 p1 o1
-tx312 = arc o2 p1 s1
-tx313 = arc s1 p2 o2
-tx314 = arc o3 p2 s1
-tx321 = arc s2 p1 o1
-tx322 = arc s2 p1 o2
-tx323 = arc s2 p1 o3
-tx324 = arc s2 p1 l1
-tx325 = arc o1 p2 s2
-tx326 = arc o2 p2 s2
-tx327 = arc o3 p2 s2
-tx328 = arc l1 p2 s2
-
-x3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx311,tx312,tx313,tx314,
-                        tx321,tx322,tx323,tx324,
-                        tx325,tx326,tx327,tx328]
-        }
-
-tx401 = arc s1 res_owl_sameAs b1
-tx402 = arc b1 res_rdf_first  o1
-tx403 = arc b1 res_rdf_rest   b2
-tx404 = arc b2 res_rdf_first  o2
-tx405 = arc b2 res_rdf_rest   b3
-tx406 = arc b3 res_rdf_first  o3
-tx407 = arc b3 res_rdf_rest   b4
-tx408 = arc b4 res_rdf_first  l1
-tx409 = arc b4 res_rdf_rest   res_rdf_nil
-
-x4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx401,tx402,tx403,tx404,
-                        tx405,tx406,tx407,tx408,
-                        tx409]
-        }
-
-tx501 = arc b1 res_owl_sameAs s1
-tx502 = arc b1 res_rdf_first  o1
-tx503 = arc b1 res_rdf_rest   b2
-tx504 = arc b2 res_rdf_first  o2
-tx505 = arc b2 res_rdf_rest   b3
-tx506 = arc b3 res_rdf_first  o3
-tx507 = arc b3 res_rdf_rest   b4
-tx508 = arc b4 res_rdf_first  l1
-tx509 = arc b4 res_rdf_rest   res_rdf_nil
-
-x5 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx501,tx502,tx503,tx504,
-                        tx505,tx506,tx507,tx508,
-                        tx509]
-        }
-
-tx601 = arc s1 res_rdf_first o1
-tx602 = arc s1 res_rdf_rest  b2
-tx603 = arc b2 res_rdf_first o2
-tx604 = arc b2 res_rdf_rest  b3
-tx605 = arc b3 res_rdf_first o3
-tx606 = arc b3 res_rdf_rest  b4
-tx607 = arc b4 res_rdf_first l1
-tx608 = arc b4 res_rdf_rest  res_rdf_nil
-
-x6 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx601,tx602,tx603,tx604,
-                        tx605,tx606,tx607,tx608]
-        }
-
-tx701 = arc b1 p2 f2
-x7f   = LookupMap [Formula b1 g2]
-x7    = NSGraph
-        { namespaces = nslist
-        , formulae   = x7f
-        , statements = [tx701]
-        }
-
-tx801 = arc f1 p2 f2
-x8f   = LookupMap [Formula f1 g2]
-x8    = NSGraph
-        { namespaces = nslist
-        , formulae   = x8f
-        , statements = [tx801]
-        }
-
-tx901 = tx801
-x9f   = LookupMap [Formula f1 g1]
-x9    = NSGraph
-        { namespaces = nslist
-        , formulae   = x9f
-        , statements = [tx901]
-        }
-
---  Test allocation of bnodes carries over a nested formula
-tx1201 = arc s1 p1 b1
-tx1202 = arc b1 p1 o1
-tx1203 = arc b2 p2 f2
-tx1204 = arc s3 p3 b3
-tx1205 = arc b3 p3 o3
-tx1211 = arc s2 p2 b4
-tx1212 = arc b4 p2 o2
-x12fg  = NSGraph
-        { namespaces = emptyNamespaceMap
-        , formulae   = emptyFormulaMap
-        , statements = [tx1211,tx1212]
-        }
-x12f   = LookupMap [Formula b2 x12fg]
-x12    = NSGraph
-        { namespaces = nslist
-        , formulae   = x12f
-        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]
-        }
-
---  List of simple anon nodes
-tx1301 = arc s1 res_rdf_first b1
-tx1302 = arc s1 res_rdf_rest  c1
-tx1303 = arc c1 res_rdf_first b2
-tx1304 = arc c1 res_rdf_rest  c2
-tx1305 = arc c2 res_rdf_first b3
-tx1306 = arc c2 res_rdf_rest  res_rdf_nil
-tx1307 = arc b1 p1 o1
-tx1308 = arc b2 p1 o2
-tx1309 = arc b3 p1 o3
-
-x13    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,
-                        tx1307,tx1308,tx1309]
-        }
-
---  List of more complex anon nodes
-tx1401 = arc s1 res_rdf_first b1
-tx1402 = arc s1 res_rdf_rest  c1
-tx1403 = arc c1 res_rdf_first b2
-tx1404 = arc c1 res_rdf_rest  c2
-tx1405 = arc c2 res_rdf_first b3
-tx1406 = arc c2 res_rdf_rest  res_rdf_nil
-tx1407 = arc b1 p1 o1
-tx1408 = arc b1 p2 o1
-tx1409 = arc b2 p1 o2
-tx1410 = arc b2 p2 o2
-tx1411 = arc b3 p1 o3
-tx1412 = arc b3 p2 o3
-
-x14    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,
-                        tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]
-        }
-
---  List with nested list
-tx1501 = arc s1 res_rdf_first b1
-tx1502 = arc s1 res_rdf_rest  c1
-tx1503 = arc c1 res_rdf_first b2
-tx1504 = arc c1 res_rdf_rest  c2
-tx1505 = arc c2 res_rdf_first b3
-tx1506 = arc c2 res_rdf_rest  res_rdf_nil
-tx1507 = arc b1 p1 o1
-tx1508 = arc b2 p2 c3
-tx1509 = arc b3 p1 o3
-
-tx1521 = arc c3 res_rdf_first b4
-tx1522 = arc c3 res_rdf_rest  c4
-tx1523 = arc c4 res_rdf_first b5
-tx1524 = arc c4 res_rdf_rest  c5
-tx1525 = arc c5 res_rdf_first b6
-tx1526 = arc c5 res_rdf_rest  res_rdf_nil
-tx1527 = arc b4 p1 o1
-tx1528 = arc b5 p1 o2
-tx1529 = arc b6 p1 o3
-
-x15    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,
-                        tx1507,tx1508,tx1509,
-                        tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,
-                        tx1527,tx1528,tx1529]
-        }
-
---  More complex list with nested list
-tx1601 = arc s1 res_rdf_first b1
-tx1602 = arc s1 res_rdf_rest  c1
-tx1603 = arc c1 res_rdf_first b2
-tx1604 = arc c1 res_rdf_rest  c2
-tx1605 = arc c2 res_rdf_first b3
-tx1606 = arc c2 res_rdf_rest  res_rdf_nil
-tx1607 = arc b1 p1 o1
-tx1608 = arc b1 p2 o1
-tx1609 = arc b2 p2 c3
-tx1610 = arc b3 p1 o3
-tx1611 = arc b3 p2 o3
-
-tx1621 = arc c3 res_rdf_first b4
-tx1622 = arc c3 res_rdf_rest  c4
-tx1623 = arc c4 res_rdf_first b5
-tx1624 = arc c4 res_rdf_rest  c5
-tx1625 = arc c5 res_rdf_first b6
-tx1626 = arc c5 res_rdf_rest  res_rdf_nil
-tx1627 = arc b4 p1 o1
-tx1628 = arc b4 p2 o1
-tx1629 = arc b5 p1 o2
-tx1630 = arc b5 p2 o2
-tx1631 = arc b6 p1 o3
-tx1632 = arc b6 p2 o3
-
-x16    = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,
-                        tx1607,tx1608,tx1609,tx1610,tx1611,
-                        tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,
-                        tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]
-        }
-
-------------------------------------------------------------
---  Simple parser tests
-------------------------------------------------------------
-
-commonPrefixes =
-    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
-    "@prefix base2 : <" ++ nsURI base2 ++ "> . \n" ++
-    "@prefix base3 : <" ++ nsURI base3 ++ "> . \n"
-
---  Single statement using <uri> form
-simpleN3Graph_g1_01 =
-    " <http://id.ninebynine.org/wip/2003/test/graph1/node/s1> " ++
-    " <http://id.ninebynine.org/wip/2003/test/graph1/node/p1> " ++
-    " <http://id.ninebynine.org/wip/2003/test/graph1/node/o1> . "
-
---  Single statement using prefix:name form
-simpleN3Graph_g1_02 =
-    "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++
-    " base1:s1 base1:p1 base1:o1 . "
-
---  Single statement using :name form
-simpleN3Graph_g1_03 =
-    "@prefix : <" ++ nsURI base1 ++ "> .\n" ++
-    " :s1 :p1 :o1 . "
-
---  Single statement using relative URI form
-simpleN3Graph_g1_04 =
-    "@base <" ++ nsURI base1 ++ "> .\n" ++
-    " <s1> <p1> <o1> . "
-
---  Single statement using blank nodes
-simpleN3Graph_g1_05 =
-    "@base <" ++ nsURI base1 ++ "> .\n" ++
-    " _:b1 _:b2 _:b3 . "
-
---  Single statement with junk following
-simpleN3Graph_g1_06 =
-    "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++
-    " base1:s1 base1:p1 base1:o1 . " ++
-    " **** "
-
---  Multiple statements
-simpleN3Graph_g2 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base2:s2 base1:p1 base2:o2 . \n" ++
-    " base3:s3 base1:p1 base3:o3 . \n"
-
---  Graph with literal
-simpleN3Graph_g3 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base1:s1 base1:p1 \"l1\" . \n"
-
---  Graph with nodeid
-simpleN3Graph_g4 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base2:s2 base1:p1 _:b1 . \n"
-
---  Graph with literal and nodeid
-simpleN3Graph_g5 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base2:s2 base1:p1 base2:o2 . \n" ++
-    " base3:s3 base1:p1 base3:o3 . \n" ++
-    " base1:s1 base1:p1 \"l1\" . \n"   ++
-    " base2:s2 base1:p1 _:b1 . \n"
-
---  Triple-quoted literal
-simpleN3Graph_g6 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base3:s3 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" . \n"
-
---  String escapes
-simpleN3Graph_g7 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 . \n" ++
-    " base3:s3 base2:p2 " ++
-    " \"l3--\\r\\\"\\'\\\\--\\u0020--\\U000000A0--\" " ++
-    " . \n"
-
---  Different verb forms
-simpleN3Graph_g8 =
-    commonPrefixes ++
-    " base1:s1 a base1:o1 . \n" ++
-    " base2:s2 = base2:o2 . \n" ++
-    " base3:s3 + base3:o3 . \n" ++
-    " base3:s3 - base3:o3 . \n" ++
-    " base3:s3 * base3:o3 . \n" ++
-    " base3:s3 / base3:o3 . \n" ++
-    " base1:s1 is  base1:p1 of base1:o1 . \n" ++
-    " base2:s2 has base1:p1 of base2:o2 . \n" ++
-    " base1:s1 >-  base2:p2 -> base1:o1 . \n" ++
-    " base2:s2 <-  base2:p2 <- base2:o2 . \n"
-
-simpleN3Graph_g81 =
-    commonPrefixes ++
-    " base1:s1 a base1:o1 . \n" ++
-    " base2:s2 = base2:o2 . \n"
-
-simpleN3Graph_g82 =
-    commonPrefixes ++
-    " base3:s3 + base3:o3 . \n" ++
-    " base3:s3 - base3:o3 . \n" ++
-    " base3:s3 * base3:o3 . \n" ++
-    " base3:s3 / base3:o3 . \n"
-
-simpleN3Graph_g83 =
-    commonPrefixes ++
-    " base1:s1 is  base1:p1 of base1:o1 . \n" ++
-    " base2:s2 has base1:p1 of base2:o2 . \n" ++
-    " base1:s1 >-  base2:p2 -> base1:o1 . \n" ++
-    " base2:s2 <-  base2:p2 <- base2:o2 . \n"
-
---  Semicolons and commas
-simpleN3Graph_g9 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 base1:o1 ; \n" ++
-    "          base1:p1 base2:o2 ; \n" ++
-    "          base2:p2 base2:o2 ; \n" ++
-    "          base2:p2 base3:o3 . \n" ++
-    " base2:s2 base1:p1 base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ; \n" ++
-    "          base2:p2 base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   . \n"
-
---  'is ... of' and semicolons and commas
-simpleN3Graph_g10 =
-    commonPrefixes ++
-    " base1:s1 has base1:p1 of base1:o1 ; \n" ++
-    "          is  base1:p1 of base2:o2 ; \n" ++
-    "          has base2:p2 of base2:o2 ; \n" ++
-    "          is  base2:p2 of base3:o3 . \n" ++
-    " base2:s2 has base1:p1 of base1:o1 , \n" ++
-    "                          base2:o2 , \n" ++
-    "                          base3:o3 , \n" ++
-    "                          \"l1\"   ; \n" ++
-    "          is  base2:p2 of base1:o1 , \n" ++
-    "                          base2:o2 , \n" ++
-    "                          base3:o3 , \n" ++
-    "                          \"l1\"   . \n"
-
---  Simple statements using ?var form
-simpleN3Graph_g11 =
-    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
-    " base1:s1 base1:p1 ?var1 . \n"          ++
-    " ?var2 base1:p1 base1:o1 . \n"          ++
-    " ?var3 base1:p1 ?var4 .    \n"
-
---  Bare anonymous nodes
-simpleN3Graph_g12 =
-    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
-    " [ base1:p1 base1:o1 ] .  \n"          ++
-    " ( ?var1 ?var2 ) .    \n"
-
---  Literals with dataype and language
-simpleN3Graph_g17 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 \"chat\"@fr . \n "                          ++
-    " base2:s2 base2:p2 \"<br/>\"^^rdf:XMLLiteral . \n "            ++
-    " base3:s3 base3:p3 \"<em>chat</em>\"^^rdf:XMLLiteral . \n "
-
-simpleTest011 = parseTest "simpleTest011" simpleN3Graph_g1_01 g1  noError
-simpleTest012 = parseTest "simpleTest012" simpleN3Graph_g1_02 g1  noError
-simpleTest013 = parseTest "simpleTest013" simpleN3Graph_g1_03 g1  noError
-simpleTest014 = parseTest "simpleTest014" simpleN3Graph_g1_04 g1  noError
-simpleTest015 = parseTest "simpleTest015" simpleN3Graph_g1_05 g1b noError
-simpleTest016 = parseTest "simpleTest016" simpleN3Graph_g1_06 emptyRDFGraph
-                ( "(line 1, column 103):\n"++
-                  "unexpected \"*\"\n"++
-                  "expecting URI or blank node or end of input" )
-simpleTest03  = parseTest "simpleTest03"  simpleN3Graph_g2    g2  noError
-simpleTest04  = parseTest "simpleTest04"  simpleN3Graph_g3    g3  noError
-simpleTest05  = parseTest "simpleTest05"  simpleN3Graph_g4    g4  noError
-simpleTest06  = parseTest "simpleTest06"  simpleN3Graph_g5    g5  noError
-simpleTest07  = parseTest "simpleTest07"  simpleN3Graph_g6    g6  noError
-simpleTest08  = parseTest "simpleTest08"  simpleN3Graph_g7    g7  noError
-simpleTest09  = parseTest "simpleTest09"  simpleN3Graph_g8    g8  noError
-simpleTest10  = parseTest "simpleTest10"  simpleN3Graph_g81   g81 noError
-simpleTest11  = parseTest "simpleTest11"  simpleN3Graph_g82   g82 noError
-simpleTest12  = parseTest "simpleTest12"  simpleN3Graph_g83   g83 noError
-simpleTest13  = parseTest "simpleTest13"  simpleN3Graph_g9    g9  noError
-simpleTest14  = parseTest "simpleTest14"  simpleN3Graph_g10   g10 noError
-simpleTest15  = parseTest "simpleTest15"  simpleN3Graph_g11   g11 noError
-simpleTest16  = parseTest "simpleTest16"  simpleN3Graph_g12   g12 noError
-simpleTest17  = parseTest "simpleTest17"  simpleN3Graph_g17   g17 noError
-
-simpleTestSuite = TestList
-  [ simpleTest011
-  , simpleTest012
-  , simpleTest013
-  , simpleTest014
-  , simpleTest015
-  , simpleTest016
-  , simpleTest03
-  , simpleTest04
-  , simpleTest05
-  , simpleTest06
-  , simpleTest07
-  , simpleTest08
-  , simpleTest09
-  , simpleTest10
-  , simpleTest11
-  , simpleTest12
-  , simpleTest13
-  , simpleTest14
-  , simpleTest15
-  , simpleTest16
-  , simpleTest17
-  ]
-
-------------------------------------------------------------
---  Exotic parser tests
-------------------------------------------------------------
---
---  These tests cover various forms of anonymous nodes
---  [...], lists and formula. together with uses of ':-'
---
-
---  Simple anon nodes, with semicolons and commas
-exoticN3Graph_x1 =
-    commonPrefixes ++
-    " [ base1:p1 base1:o1 ; \n" ++
-    "   base1:p1 base2:o2 ; \n" ++
-    "   base2:p2 base2:o2 ; \n" ++
-    "   base2:p2 base3:o3 ] = base1:s1 . \n" ++
-    " base2:s2 = \n" ++
-    " [ base1:p1 base1:o1 , \n" ++
-    "   base2:o2 , \n" ++
-    "   base3:o3 , \n" ++
-    "   \"l1\"   ; \n" ++
-    "   base2:p2 base1:o1 , \n" ++
-    "            base2:o2 , \n" ++
-    "            base3:o3 , \n" ++
-    "            \"l1\"   ] . \n"
-
---  Simple anon nodes, with 'is ... of' and semicolons and commas
-exoticN3Graph_x2 =
-    commonPrefixes ++
-    " [ has base1:p1 of base1:o1 ; \n" ++
-    "   is  base1:p1 of base2:o2 ; \n" ++
-    "   has base2:p2 of base2:o2 ; \n" ++
-    "   is  base2:p2 of base3:o3 ] = base1:s1 . \n" ++
-    " base2:s2 = \n" ++
-    " [ has base1:p1 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ; \n" ++
-    "   is  base2:p2 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ] . \n"
-
-
---  Simple anon nodes, attached to identified node
-exoticN3Graph_x3 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    " [ has base1:p1 of base1:o1 ; \n" ++
-    "   is  base1:p1 of base2:o2 ; \n" ++
-    "   has base2:p2 of base2:o2 ; \n" ++
-    "   is  base2:p2 of base3:o3 ] . \n" ++
-    " base2:s2 :- \n" ++
-    " [ has base1:p1 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ; \n" ++
-    "   is  base2:p2 of base1:o1 , \n" ++
-    "                   base2:o2 , \n" ++
-    "                   base3:o3 , \n" ++
-    "                   \"l1\"   ] . \n"
-
-
---  List nodes, with and without :-
-
-exoticN3Graph_x4 =
-    commonPrefixes ++
-    " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
-
-exoticN3Graph_x5 =
-    commonPrefixes ++
-    " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"
-
-exoticN3Graph_x6 =
-    commonPrefixes ++
-    " base1:s1 :- (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
-
---  Formula nodes, with and without :-
-
-exoticN3Graph_x7 =
-    commonPrefixes ++
-    " { base1:s1 base1:p1 base1:o1 .   \n" ++
-    "   base2:s2 base1:p1 base2:o2 .   \n" ++
-    "   base3:s3 base1:p1 base3:o3 . } \n" ++
-    " base2:p2 base2:f2 . "
-
-exoticN3Graph_x8 =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    " { base1:s1 base1:p1 base1:o1 .     \n" ++
-    "   base2:s2 base1:p1 base2:o2 .     \n" ++
-    "   base3:s3 base1:p1 base3:o3 . } ; \n" ++
-    " base2:p2 base2:f2 . "
-
-exoticN3Graph_x9 =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    "   { base1:s1 base1:p1 base1:o1 } ; \n" ++
-    "   base2:p2 base2:f2 "
-    -- (also omits final periods)
-
-exoticN3Graph_x8a =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    " { base1:s1 base1:p1 base1:o1 .     \n" ++
-    "   base2:s2 base1:p1 base2:o2 .     \n" ++
-    "   base3:s3 base1:p1 base3:o3 . } . \n" ++
-    " base1:f1 base2:p2 base2:f2 . "
-
-exoticN3Graph_x9a =
-    commonPrefixes ++
-    " base1:f1 :- \n" ++
-    " { base1:s1 base1:p1 base1:o1 . } . \n" ++
-    " base1:f1 base2:p2 base2:f2 . "
-
---  Test allocation of bnodes carries over a nested formula
-exoticN3Graph_x12 =
-    commonPrefixes ++
-    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" ++
-    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++
-    "            base2:p2 base2:f2 .                \n" ++
-    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."
-
---  List of bnodes
-exoticN3Graph_x13 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1] \n" ++
-    "    [base1:p1 base2:o2] \n" ++
-    "    [base1:p1 base3:o3] ) .\n"
-
---  List of more complex bnodes
-exoticN3Graph_x14 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
-    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
-    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
-
---  List with nested list
-exoticN3Graph_x15 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1] \n"++
-    "    [base2:p2 \n" ++
-    "       ( [base1:p1 base1:o1] \n" ++
-    "         [base1:p1 base2:o2] \n" ++
-    "         [base1:p1 base3:o3] ) ] \n"++
-    "    [base1:p1 base3:o3] ) .\n"
-
---  More complex list with nested list
-exoticN3Graph_x16 =
-    commonPrefixes ++
-    " base1:s1 :- \n" ++
-    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"++
-    "    [base2:p2 \n" ++
-    "       ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
-    "         [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
-    "         [base1:p1 base3:o3; base2:p2 base3:o3] ) ] \n"++
-    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
-
-exoticTest01 = parseTest "exoticTest01" exoticN3Graph_x1  x1  noError
-exoticTest02 = parseTest "exoticTest02" exoticN3Graph_x2  x2  noError
-exoticTest03 = parseTest "exoticTest03" exoticN3Graph_x3  x3  noError
-exoticTest04 = parseTest "exoticTest04" exoticN3Graph_x4  x4  noError
-exoticTest05 = parseTest "exoticTest05" exoticN3Graph_x5  x5  noError
-exoticTest06 = parseTest "exoticTest06" exoticN3Graph_x6  x6  noError
-exoticTest07 = parseTest "exoticTest07" exoticN3Graph_x7  x7  noError
-exoticTest08 = parseTest "exoticTest08" exoticN3Graph_x8  x8  noError
-exoticTest09 = parseTest "exoticTest09" exoticN3Graph_x9  x9  noError
-exoticTest10 = parseTest "exoticTest10" exoticN3Graph_x8a x8  noError
-exoticTest11 = parseTest "exoticTest11" exoticN3Graph_x9a x9  noError
-exoticTest12 = parseTest "exoticTest12" exoticN3Graph_x12 x12 noError
-exoticTest13 = parseTest "exoticTest13" exoticN3Graph_x13 x13 noError
-exoticTest14 = parseTest "exoticTest14" exoticN3Graph_x14 x14 noError
-exoticTest15 = parseTest "exoticTest15" exoticN3Graph_x15 x15 noError
-exoticTest16 = parseTest "exoticTest16" exoticN3Graph_x16 x16 noError
-exoticTest20 = testGraphEq "exoticTest20" False x7 x8
-exoticTest21 = testGraphEq "exoticTest21" False x8 x9
-
-exoticTestSuite = TestList
-  [ exoticTest01
-  , exoticTest02
-  , exoticTest03
-  , exoticTest04
-  , exoticTest05
-  , exoticTest06
-  , exoticTest07
-  , exoticTest08
-  , exoticTest09
-  , exoticTest10
-  , exoticTest11
-  , exoticTest12
-  , exoticTest13
-  , exoticTest14
-  , exoticTest15
-  , exoticTest16
-  , exoticTest20
-  , exoticTest21
-  ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ charTestSuite
-  , nameTestSuite
-  , prefixTestSuite
-  , absUriRefTestSuite
-  , uriRef2TestSuite
-  , simpleTestSuite
-  , exoticTestSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/N3ParserTest.hs,v $
--- $Author: graham $
--- $Revision: 1.25 $
--- $Log: N3ParserTest.hs,v $
--- Revision 1.25  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.24  2004/01/09 11:23:54  graham
--- Fix up N3Parser so that the final statement-terminating '.' in a formula
--- or file is optional.
---
--- Revision 1.23  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.22  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.21  2003/12/03 17:07:23  graham
--- Replace occurrences of QName in N3Parser with ScopedName.
---
--- Revision 1.20  2003/12/03 15:42:09  graham
--- Eliminate special return type in favour of ErrorM
---
--- Revision 1.19  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.18  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.17  2003/10/09 16:26:31  graham
--- Added parser support for literal language tags and datatypes.
--- (Language tags are names, not strictly per RFC3066)
---
--- Revision 1.16  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.15  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.14  2003/07/01 14:18:57  graham
--- Allow blank node in predicate position.
--- Add parser and formatter test case for this.
---
--- Revision 1.13  2003/06/12 00:47:56  graham
--- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
---
--- Revision 1.12  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.11  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.10  2003/05/23 00:02:42  graham
--- Fixed blank node id generation bug in N3Formatter
---
--- Revision 1.9  2003/05/22 15:16:39  graham
--- Added additional parser test cases for lists
---
--- Revision 1.8  2003/05/21 13:55:13  graham
--- N3 parser now handles relative URIs and default prefixes.
--- (Still need to figure better default base URI handling; i.e. current document)
---
--- Revision 1.7  2003/05/21 13:34:13  graham
--- Various N3 parser bug fixes.
--- Need to fix handling of :name terms.
---
--- Revision 1.6  2003/05/14 16:50:32  graham
--- Graph matching seems solid now:
--- RDFGraphTest and N3ParserTest pass all tests
--- Updated TODO file with comments from code
---
--- Revision 1.5  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.4  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.3  2003/04/30 12:14:08  graham
--- Add formetter test to CVS
--- Noted problem with RDFGraph structure: preparing to rework
---
--- Revision 1.2  2003/04/17 12:28:05  graham
--- Formula parsing seems OK.
--- There remains a question about how to represent
--- and compare graphs containing formulae.
---
--- Revision 1.1  2003/04/17 00:35:38  graham
--- Added module N3ParserTest
--- N3parser is mostly working
--- Formulae remain to test
---
− Swish/HaskellRDF/ParsecLanguage.hs 
@@ -1,115 +0,0 @@--------------------------------------------------------------------- Daan Leijen (c) 1999-2001, daan@cs.uu.nl--- --- a helper module that defines some language definitions--- that can be used to instantiate a token parser (see ParsecToken)--- --- $Revision: 1.3 $--- $Author: daan $--- $Date: 2001/10/03 09:21:38 $------------------------------------------------------------------module Swish.HaskellRDF.ParsecLanguage( haskellDef, haskell-                                       , mondrianDef, mondrian-                   -                                       , emptyDef-                                       , haskellStyle-                                       , javaStyle   -                                       , LanguageDef (..)                -                                       ) where--import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Token --           --------------------------------------------------------------- Styles: haskellStyle, javaStyle------------------------------------------------------------               --haskellStyle= emptyDef                      -                { commentStart   = "{-"-                , commentEnd     = "-}"-                , commentLine    = "--"-                , nestedComments = True-                , identStart     = letter-                , identLetter	 = alphaNum <|> oneOf "_'"-                , opStart	 = opLetter haskellStyle-                , opLetter	 = oneOf ":!#$%&*+./<=>?@\\^|-~"              -                , reservedOpNames= []-                , reservedNames  = []-                , caseSensitive  = True                                   -                }         -                           -javaStyle   = emptyDef-		{ commentStart	 = "/*"-		, commentEnd	 = "*/"-		, commentLine	 = "//"-		, nestedComments = True-		, identStart	 = letter-		, identLetter	 = alphaNum <|> oneOf "_'"		-		, reservedNames  = []-		, reservedOpNames= []	-                , caseSensitive  = False				  -		}---------------------------------------------------------------- minimal language definition------------------------------------------------------------                -emptyDef    = LanguageDef -               { commentStart   = ""-               , commentEnd     = ""-               , commentLine    = ""-               , nestedComments = True-               , identStart     = letter <|> char '_'-               , identLetter    = alphaNum <|> oneOf "_'"-               , opStart        = opLetter emptyDef-               , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"-               , reservedOpNames= []-               , reservedNames  = []-               , caseSensitive  = True-               }-                ----------------------------------------------------------------- Haskell------------------------------------------------------------               -haskell :: TokenParser st-haskell      = makeTokenParser haskellDef--haskellDef   = haskell98Def-	        { identLetter	 = identLetter haskell98Def <|> char '#'-	        , reservedNames	 = reservedNames haskell98Def ++ -    				   ["foreign","import","export","primitive"-    				   ,"_ccall_","_casm_"-    				   ,"forall"-    				   ]-                }-			    -haskell98Def = haskellStyle-                { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]-                , reservedNames  = ["let","in","case","of","if","then","else",-                                    "data","type",-                                    "class","default","deriving","do","import",-                                    "infix","infixl","infixr","instance","module",-                                    "newtype","where",-                                    "primitive"-                                    -- "as","qualified","hiding"-                                   ]-                }         -                -                --------------------------------------------------------------- Mondrian------------------------------------------------------------               -mondrian :: TokenParser st-mondrian    = makeTokenParser mondrianDef--mondrianDef = javaStyle-		{ reservedNames = [ "case", "class", "default", "extends"-				  , "import", "in", "let", "new", "of", "package"-				  ]	-                , caseSensitive  = True				  -		}--
− Swish/HaskellRDF/Proof.hs 
@@ -1,361 +0,0 @@---------------------------------------------------------------------------------
---  $Id: Proof.hs,v 1.19 2004/01/07 19:49:12 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Proof
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a framework for constructing proofs
---  over some expression form.  It is intended to be used
---  with RDF graphs, but the structures aim to be quite
---  generic with respect to the expression forms allowed.
---
---  It does not define any proof-finding strategy.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.Proof
-    ( Proof(..), Step(..)
-    , checkProof, explainProof, checkStep, showProof, showsProof, showsFormula )
-where
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..)
-    , fwdCheckInference
-    , showsFormula, showsFormulae, showsWidth )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI )
-
-import Swish.HaskellUtils.ShowM
-    ( ShowM(..), showm )
-
-import Swish.HaskellUtils.ListHelpers
-    ( subset )
-
-import Data.List
-    ( union, intersect, intersperse )
-
-import Data.Maybe
-    ( isJust, fromJust, catMaybes )
-
-
-------------------------------------------------------------
---  Proof framework
-------------------------------------------------------------
-
--- |Step in proof chain
---
---  The display name for a proof step comes from the display name of its
---  consequence formula.
-data Step ex = Step
-    { stepRule :: Rule ex           -- ^ Inference rule used
-    , stepAnt  :: [Formula ex]      -- ^ Antecedents of inference rule
-    , stepCon  :: Formula ex        -- ^ Named consequence of inference rule
-    } deriving Show
-
--- |Proof is a structure that presents a chain of rule applications
---  that yield a result expression from a given expression
-data Proof ex = Proof
-    { proofContext :: [Ruleset ex]  -- ^ Proof context:  list of rulesets,
-                                    --   each of which provides a number of
-                                    --   axioms and rules.
-    , proofInput   :: Formula ex    -- ^ Given expression
-    , proofResult  :: Formula ex    -- ^ Result expression
-    , proofChain   :: [Step ex]     -- ^ Chain of inference rule applications
-                                    --   progressing from input to result
-    }
-
--- |Return a list of axioms from all the rulesets in a proof
-proofAxioms = concat . map rsAxioms . proofContext
-
--- |Return a list of rules from all the rulesets in a proof
-proofRules = concat . map rsRules . proofContext
-
--- |Return list of axioms actually referenced by a proof
-proofAxiomsUsed :: Proof ex -> [Formula ex]
-proofAxiomsUsed proof = foldl union [] $ map stepAxioms (proofChain proof)
-    where
-        stepAxioms st = stepAnt st `intersect` proofAxioms proof
-
--- |Check consistency of given proof.
---  The supplied rules and axioms are assumed to be correct.
-checkProof :: (Expression ex) => Proof ex -> Bool
-checkProof pr =
-    checkProof1 (proofRules pr) initExpr (proofChain pr) goalExpr
-    where
-        initExpr = (formExpr $ proofInput pr):(map formExpr $ proofAxioms pr)
-        goalExpr = (formExpr $ proofResult pr)
-
-checkProof1 :: (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
-checkProof1 _     prev []       res = res `elem` prev
-checkProof1 rules prev (st:steps) res =
-    checkStep rules prev st &&
-    checkProof1 rules ((formExpr $ stepCon st):prev) steps res
-
---  A proof step is valid if rule is in list of rules
---  and the antecedents are sufficient to obtain the conclusion
---  and the antecedents are in the list of formulae already proven.
---
---  Note:  this function depends on the ruleName of any rule being
---  unique among all rules.  In particular the name of the step rule
---  being in correspondence with the name of one of the indicated
---  valid rules of inference.
-checkStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Bool
-checkStep rules prev step =
-    -- Rule name is one of supplied rules, and
-    (ruleName srul `elem` map ruleName rules) &&
-    -- Antecedent expressions are all previously accepted expressions
-    (sant `subset` prev)   &&
-    -- Inference rule yields concequence from antecendents
-    checkInference srul sant scon
-    where
-        --  Rule from proof step:
-        srul = stepRule step
-        --  Antecedent expressions from proof step:
-        sant = map formExpr $ stepAnt step
-        --  Consequentent expression from proof step:
-        scon = formExpr $ stepCon step
-
-
-{-
-    (formExpr (stepCon step) `elem` sfwd)
-    -- (or $ map (`subset` sant) sbwd)
-    where
-        --  Rule from proof step:
-        srul = stepRule step
-        --  Antecedent expressions from proof step:
-        sant = map formExpr $ stepAnt step
-        --  Forward chaining from antecedents of proof step
-        scon = map formExpr $ stepCon step
-        --  Forward chaining from antecedents of proof step
-
-        sfwd = fwdApply srul sant
-        --  Backward chaining from consequent of proof step
-        --  (Does not work because of introduction of existentials)
-        sbwd = bwdApply srul (formExpr $ stepCon step)
--}
-
--- |Check proof, and return identification of failing step.
-explainProof ::
-    (Expression ex) => Proof ex -> Maybe String
-explainProof pr =
-    explainProof1 (proofRules pr) initExpr (proofChain pr) goalExpr
-    where
-        initExpr = (formExpr $ proofInput pr):(map formExpr $ proofAxioms pr)
-        goalExpr = (formExpr $ proofResult pr)
-
-explainProof1 ::
-    (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
-explainProof1 _     prev []       res   =
-    if res `elem` prev then Nothing else Just "Result not demonstrated"
-explainProof1 rules prev (st:steps) res =
-    case explainStep rules prev st  of
-        Nothing -> explainProof1 rules ((formExpr $ stepCon st):prev) steps res
-        Just ex -> Just ("Invalid step: "++show (formName $ stepCon st)++": "++ex)
-
---  A proof step is valid if rule is in list of rules
---  and the antecedents are sufficient to obtain the conclusion
---  and the antecedents are in the list of formulae already proven.
---
---  Note:  this function depends on the ruleName of any rule being
---  unique among all rules.  In particular the name of the step rule
---  being in correspondence with the name of one of the indicated
---  valid rules of inference.
---
---  Return Nothing if step is OK, or Just string describing failure
---
-explainStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Maybe String
-explainStep rules prev step =
-        if null errors then Nothing else Just $ concat (intersperse ", " errors)
-    where
-        --  Rule from proof step:
-        srul = stepRule step
-        --  Antecedent expressions from proof step:
-        sant = map formExpr $ stepAnt step
-        --  Consequentent expression from proof step:
-        scon = formExpr $ stepCon step
-        --  Tests for step to be valid
-        errors = catMaybes
-            -- Rule name is one of supplied rules, and
-            [ require (ruleName srul `elem` map ruleName rules)
-                      ("rule "++show (ruleName srul)++" not present")
-            -- Antecedent expressions are all previously accepted expressions
-            , require (sant `subset` prev)
-                      ("antecedent not axiom or previous result")
-            -- Inference rule yields consequence from antecedents
-            , require (checkInference srul sant scon)
-                      ("rule does not deduce consequence from antecedents")
-            ]
-        require b s = if b then Nothing else Just s
-
--- |showsProof
---  Create a displayable form of a proof, returned as a ShowS value.
---
---  This function is intended to allow the calling function some control
---  of multiline displays by providing:
---  (1) the first line of the proof is not preceded by any text, so
---      it may be appended to some preceding text on the same line,
---  (2) the supplied newline string is used to separate lines of the
---      formatted text, and may include any desired indentation, and
---  (3) no newline is output following the final line of text.
-showsProof :: (ShowM ex) => String -> Proof ex -> ShowS
-showsProof newline proof =
-    if null axioms then shProof else shAxioms . shProof
-    where
-        axioms = proofAxiomsUsed proof
-        shAxioms =
-            showString    ("Axioms:" ++ newline) .
-            showsFormulae newline (proofAxiomsUsed proof) newline
-        shProof =
-            showString    ("Input:" ++ newline) .
-            showsFormula  newline (proofInput  proof) .
-            showString    (newline ++ "Proof:" ++ newline) .
-            showsSteps    newline (proofChain  proof)
-
--- |showProof
---  Returns a simple string representation of a proof.
-showProof :: (ShowM ex) => String -> Proof ex -> String
-showProof newline proof = showsProof newline proof ""
-
--- |showsSteps
---  Create a displayable form of a list of labelled proof steps
-showsSteps :: (ShowM ex) => String -> [Step ex] -> ShowS
-showsSteps _       []     = id
-showsSteps newline [s]    = showsStep  newline s
-showsSteps newline (s:ss) = showsStep  newline s .
-                            showString newline .
-                            showsSteps newline ss
-
--- |showsStep
---  Create a displayable form of a labelled proof step.
-showsStep :: (ShowM ex) => String -> Step ex -> ShowS
-showsStep newline s = showsFormula newline (stepCon s) .
-                      showString newline .
-                      showString ("  (by ["++rulename++"] from "++antnames++")")
-    where
-        rulename = show . ruleName $ stepRule s
-        antnames = showNames $ map (show . formName) (stepAnt s)
-
--- |showNames
---  Return a string containing a list of names.
-showNames :: [String] -> String
-showNames []      = "<nothing>"
-showNames [n]     = showName n
-showNames [n1,n2] = showName n1 ++ " and " ++ showName n2
-showNames (n1:ns) = showName n1 ++ ", " ++ showNames ns
-
--- |showNames
---  Return a string representing a single name.
-showName n = "["++n++"]"
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Proof.hs,v $
--- $Author: graham $
--- $Revision: 1.19 $
--- $Log: Proof.hs,v $
--- Revision 1.19  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.18  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.17  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.16  2003/09/30 20:02:39  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.15  2003/09/30 16:39:41  graham
--- Refactor proof code to use new ruleset logic.
--- Moved some support code from RDFProofCheck to RDFRuleset.
---
--- Revision 1.14  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.13  2003/07/02 13:51:14  graham
--- Intermediate save:  partially coded RDFS rules.
---
--- Revision 1.12  2003/07/01 14:20:30  graham
--- Added instance entailment to proof check module.
---
--- Revision 1.11  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.10  2003/06/26 15:37:23  graham
--- Added rdfQueryInstance, and tests, all works.
---
--- Revision 1.9  2003/06/25 21:16:53  graham
--- Reworked N3 formatting logic to support proof display.
--- Basic proof display is working.
---
--- Revision 1.8  2003/06/24 23:08:18  graham
--- Replaced Rule class with algebraic data type
---
--- Revision 1.7  2003/06/24 19:56:31  graham
--- Basic proof-check now works
---
--- Revision 1.6  2003/06/19 19:49:07  graham
--- RDFProofCheck compiles, but test fails
---
--- Revision 1.5  2003/06/18 18:40:08  graham
--- Basic proof backchaining tests OK.
--- Next:  add filtering on variable bindings.
---
--- Revision 1.4  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.3  2003/06/10 01:04:46  graham
--- Proof framework in progress;  compiles, incomplete
---
--- Revision 1.2  2003/06/04 00:49:53  graham
--- Proof module compiles OK
---
--- Revision 1.1  2003/06/03 19:24:54  graham
--- Started work on inference/proof module
---
− Swish/HaskellRDF/RDFDatatype.hs 
@@ -1,290 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFDatatype.hs,v 1.14 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFDatatype
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + existential types
---
---  This module defines the structures used by Swish to represent and
---  manipulate RDF datatypes.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype
-    , RDFDatatypeVal
-    , RDFDatatypeMod
-    , RDFModifierFn, RDFApplyModifier
-    , makeRdfDtOpenVarBindingModify, makeRdfDtOpenVarBindingModifiers
-    , applyRDFDatatypeMod
-    , RDFDatatypeSub
-    , fromRDFLabel, toRDFLabel, makeDatatypedLiteral
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , isDatatyped
-    , getLiteralText
-    , RDFGraph
-    )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding, nullRDFVarBinding
-    , RDFVarBindingModify, RDFOpenVarBindingModify
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( Datatype -- , typeName, typeRules
-    , DatatypeVal(..)
-    , getDTMod
-    , DatatypeMap(..)
-    , DatatypeMod(..), ModifierFn
-    , nullDatatypeMod
-    , ApplyModifier
-    , DatatypeSub(..)
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getQName
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , boundVars, subBinding, makeVarBinding
-    , applyVarBinding, joinVarBindings, addVarBinding
-    , VarBindingModify(..)
-    )
-
-import Data.Maybe
-    ( Maybe(..), fromMaybe, isJust, fromJust )
-
-import Control.Monad
-    ( liftM )
-
-------------------------------------------------------------
---  Specialize datatype framework types for use with RDF
-------------------------------------------------------------
-
--- |RDF datatype wrapper used with RDF graph values
---
-type RDFDatatype = Datatype RDFGraph RDFLabel RDFLabel
-
--- |RDF datatype value used with RDF graph values
---
-type RDFDatatypeVal vt = DatatypeVal RDFGraph vt RDFLabel RDFLabel
-
--- |RDF datatype modifier used with RDF graph values
---
-type RDFDatatypeMod vt = DatatypeMod vt RDFLabel RDFLabel
-
--- |Describe a subtype/supertype relationship between a pair
---  of RDF datatypes.
---
-type RDFDatatypeSub supvt subvt = DatatypeSub RDFGraph RDFLabel RDFLabel supvt subvt
-
--- |RDF value modifier function type
---
---  This indicates a modifier function that operates on RDFLabel values.
---
-type RDFModifierFn = ModifierFn RDFLabel
-
--- |RDF value modifier application function type
---
---  This indicates a function that applies RDFModifierFn functions.
---
-type RDFApplyModifier = ApplyModifier RDFLabel RDFLabel
-
---------------------------------------------------------------
---  Functions for creating datatype variable binding modifiers
---------------------------------------------------------------
-
--- |Create an RDFOpenVarBindingModify value.
---
---  dtval   is an RDFDatatype value containing details of the datatype
---          for which a variable binding modifier is created.
---  dtmod   is the data value modifier value that defines the calculations
---          that are used to implement a variable binding modifier.
---
---  The key purpose of this function is to "lift" the supplied
---  variable constraint functions from operating on data values directly
---  to a corresponding list of functions that operate on values contained
---  in RDF graph labels (i.e. RDF literal nodes).  It also applies
---  node type checking, such that if the actual RDF nodes supplied do
---  not contain appropriate values then the variable binding is not
---  accepted.
---
-makeRdfDtOpenVarBindingModify ::
-    RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
-makeRdfDtOpenVarBindingModify dtval dtmod =
-    dmAppf dtmod (dmName dtmod) $ map (makeRDFModifierFn dtval) (dmModf dtmod)
-
--- |Create all RDFOpenVarBindingModify values for a given datatype value.
---  See makeRdfDtOpenVarBindingModify abovr.
---
---  dtval   is an RDFDatatype value containing details of the datatype
---          for which variable binding modifiers are created.
---
-makeRdfDtOpenVarBindingModifiers ::
-    RDFDatatypeVal vt -> [RDFOpenVarBindingModify]
-makeRdfDtOpenVarBindingModifiers dtval =
-    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)
-
--- |Apply a datatype modifier using supplied RDF labels to a supplied
---  RDF variable binding.
---
-applyRDFDatatypeMod ::
-    RDFDatatypeVal vt -> RDFDatatypeMod vt -> [RDFLabel] -> [RDFVarBinding]
-    -> [RDFVarBinding]
-applyRDFDatatypeMod dtval dtmod lbs =
-    vbmApply (makeRdfDtOpenVarBindingModify dtval dtmod lbs)
-
--- |Given details of a datatype and a single value constraint function,
---  return a new constraint function that operates on RDFLabel values.
---
---  The returned constraint function incorporates checks for appropriately
---  typed literal nodes, and returns similarly typed literal nodes.
---
-makeRDFModifierFn ::
-    RDFDatatypeVal vt -> ModifierFn vt -> RDFModifierFn
-makeRDFModifierFn dtval fn ivs =
-    let
-        ivals = sequence $ map (rdfNodeExtract dtval) ivs
-        ovals | isJust ivals = fn (fromJust ivals)
-              | otherwise    = []
-    in
-        fromMaybe [] $ sequence $ map (rdfNodeInject dtval) ovals
-
--- |Extract datatyped value from RDFLabel value, or return Nothing.
---
-rdfNodeExtract :: RDFDatatypeVal vt -> RDFLabel -> Maybe vt
-rdfNodeExtract dtval node
-    | isDatatyped dtname node = mapL2V dtmap $ getLiteralText node
-    | otherwise               = Nothing
-    where
-        dtname = tvalName dtval
-        dtmap  = tvalMap  dtval
-
--- |Return new RDF literal node with a representation of the supplied
---  value, or Nothing.
---
-rdfNodeInject :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel
-rdfNodeInject dtval val = maybeNode valstr
-    where
-        valstr = mapV2L (tvalMap  dtval) val
-        maybeNode Nothing    = Nothing
-        maybeNode (Just str) = Just $ Lit str (Just (tvalName dtval))
-
-------------------------------------------------------------
---  Helpers to map between datatype values and RDFLabels
-------------------------------------------------------------
-
-fromRDFLabel ::
-    RDFDatatypeVal vt -> RDFLabel -> Maybe vt
-fromRDFLabel dtv lab
-    | isDatatyped dtnam lab = mapL2V dtmap $ getLiteralText lab
-    | otherwise             = Nothing
-    where
-        dtnam = tvalName dtv
-        dtmap = tvalMap dtv
-
-toRDFLabel :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel
-toRDFLabel dtv =
-    liftM (makeDatatypedLiteral dtnam) . mapV2L dtmap
-    where
-        dtnam = tvalName dtv
-        dtmap = tvalMap dtv
-
-makeDatatypedLiteral :: ScopedName -> String -> RDFLabel
-makeDatatypedLiteral dtnam strval =
-    Lit strval (Just dtnam)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFDatatype.hs,v $
--- $Author: graham $
--- $Revision: 1.14 $
--- $Log: RDFDatatype.hs,v $
--- Revision 1.14  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.13  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.12  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.11  2003/12/08 17:29:19  graham
--- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
---
--- Revision 1.10  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.9  2003/11/25 23:02:17  graham
--- Reworked datatype variable modifier logic.
--- Limited range of test cases so far all pass.
---
--- Revision 1.8  2003/11/24 22:13:09  graham
--- Working on reworking datatype variable modifiers to work with
--- revised datatype framework.
---
--- Revision 1.7  2003/11/14 21:48:35  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.6  2003/11/13 01:14:32  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.4  2003/11/11 21:02:55  graham
--- Working on datatype class-constraint inference rule.  Incomplete.
---
--- Revision 1.3  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.2  2003/10/24 21:05:08  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.1  2003/10/22 15:46:38  graham
--- Add RDFDatatype module.
---
− Swish/HaskellRDF/RDFDatatypeXsdInteger.hs 
@@ -1,609 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFDatatypeXsdInteger.hs,v 1.15 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFDatatypeXsdInteger
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines the structures used by swish to represent and
---  manipulate RDF datatypes.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFDatatypeXsdInteger
-    ( rdfDatatypeXsdInteger
-    , rdfDatatypeValXsdInteger
-    , typeNameXsdInteger, namespaceXsdInteger
-    , axiomsXsdInteger, rulesXsdInteger
-    , prefixXsdInteger
-    )
-where
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula 
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype
-    , RDFDatatypeVal
-    , RDFDatatypeMod
-    , makeRdfDtOpenVarBindingModifiers
-    )
-
-import Swish.HaskellRDF.ClassRestrictionRule
-    ( makeRDFDatatypeRestrictionRules
-    )
-
-import Swish.HaskellRDF.MapXsdInteger
-    ( mapXsdInteger
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( Datatype(..)
-    , DatatypeVal(..)
-    , DatatypeRel(..), DatatypeRelPr
-    , altArgs
-    , UnaryFnTable,    unaryFnApp
-    , BinaryFnTable,   binaryFnApp
-    , BinMaybeFnTable, binMaybeFnApp
-    , DatatypeMod(..) 
-    , makeVmod_1_1_inv, makeVmod_1_1
-    , makeVmod_2_1_inv, makeVmod_2_1
-    , makeVmod_2_0
-    , makeVmod_2_2
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( makeRuleset
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceXSD
-    , namespaceMATH
-    , namespaceXsdType
-    )
-
-import Data.Maybe
-    ( Maybe (..), maybeToList )
-
-import Control.Monad
-    ( liftM )
-
-------------------------------------------------------------
---  Misc values
-------------------------------------------------------------
-
---  Local name for Integer datatype
-nameXsdInteger      = "integer"
-
--- |Type name for xsd:integer datatype
-typeNameXsdInteger  = ScopedName namespaceXSD nameXsdInteger
-
--- |Namespace for xsd:integer datatype functions
-namespaceXsdInteger = namespaceXsdType nameXsdInteger
-
---  Helper to catenate strings with newline separator,
---  used for making textual representations of graphs.
---  (the newline makes N3 parser diagnostics easier to interpret)
---
-infixr 5 +++
-(+++) :: String -> ShowS
-(+++) str = ((str++"\n")++)
-
---  Compose with function of two arguments
-c2 = (.) . (.)
-
---  Integer power (exponentiation) function
---  returns Nothing if exponent is negative.
---
-intPower :: Integer -> Integer -> Maybe Integer
-intPower a b = if b < 0 then Nothing else Just (intPower1 a b)
-    where
-        intPower1 a b
-            | q == 1           = atopsq*a
-            | p == 0           = 1
-            | otherwise        = atopsq
-            where
-                (p,q)  = b `divMod` 2
-                atop   = intPower1 a p
-                atopsq = atop*atop
-
-------------------------------------------------------------
---  Declare exported RDFDatatype value for xsd:integer
-------------------------------------------------------------
-
-rdfDatatypeXsdInteger :: RDFDatatype
-rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger
-
-------------------------------------------------------------
---  Implmentation of RDFDatatypeVal for xsd:integer
-------------------------------------------------------------
-
--- |Define Datatype value for xsd:integer
---  Members of this datatype are positive or negative integer values.
---
---  The lexical form consists of an option '+' or '-'
---  followed by a sequence of decimal digits.
---
---  The canonical lexical form has leading zeros and '+' sign removed.
---
-rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer
-rdfDatatypeValXsdInteger = DatatypeVal
-    { tvalName      = typeNameXsdInteger
-    , tvalRules     = rdfRulesetXsdInteger  -- Ruleset RDFGraph
-    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger
-                                            -- RDFGraph -> [RDFRules]
-    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger
-    , tvalMap       = mapXsdInteger         -- DatatypeMap Integer
-    , tvalRel       = relXsdInteger         -- [DatatypeRel Integer]
-    , tvalMod       = modXsdInteger         -- [DatatypeMod Integer]
-    }
-
--- |relXsdInteger contains arithmetic and other relations for xsd:Integer values.
---
---  The functions are inspired by those defined by CWM as math: properties.
---  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)
---
-
-relXsdInteger :: [DatatypeRel Integer]
-relXsdInteger =
-    [ relXsdIntegerAbs
-    , relXsdIntegerNeg
-    , relXsdIntegerSum
-    , relXsdIntegerDiff
-    , relXsdIntegerProd
-    , relXsdIntegerDivMod
-    , relXsdIntegerPower
-    , relXsdIntegerEq
-    , relXsdIntegerNe
-    , relXsdIntegerLt
-    , relXsdIntegerLe
-    , relXsdIntegerGt
-    , relXsdIntegerGe
-    ]
-
-mkIntRel2 ::
-    String -> DatatypeRelPr Integer -> UnaryFnTable Integer
-    -> DatatypeRel Integer
-mkIntRel2 nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdInteger nam
-    , dtRelFunc = altArgs pr fns unaryFnApp
-    }
-
-mkIntRel3 ::
-    String -> DatatypeRelPr Integer -> BinaryFnTable Integer
-    -> DatatypeRel Integer
-mkIntRel3 nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdInteger nam
-    , dtRelFunc = altArgs pr fns binaryFnApp
-    }
-
-mkIntRel3maybe ::
-    String -> DatatypeRelPr Integer -> BinMaybeFnTable Integer
-    -> DatatypeRel Integer
-mkIntRel3maybe nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdInteger nam
-    , dtRelFunc = altArgs pr fns binMaybeFnApp
-    }
-
-relXsdIntegerAbs :: DatatypeRel Integer
-relXsdIntegerAbs = mkIntRel2 "abs" (const True)
-    [ ( (>=0),      [ (abs,1) ] )
-    , ( const True, [ (id,0), (negate,0) ] )
-    ]
-
-relXsdIntegerNeg :: DatatypeRel Integer
-relXsdIntegerNeg = mkIntRel2 "neg" (const True)
-    [ ( const True, [ (negate,1) ] )
-    , ( const True, [ (negate,0) ] )
-    ]
-
-relXsdIntegerSum :: DatatypeRel Integer
-relXsdIntegerSum = mkIntRel3 "sum" (const True)
-    [ ( const True, [ ((+),1,2) ] )
-    , ( const True, [ ((-),0,2) ] )
-    , ( const True, [ ((-),0,1) ] )
-    ]
-
-relXsdIntegerDiff :: DatatypeRel Integer
-relXsdIntegerDiff = mkIntRel3 "diff" (const True)
-    [ ( const True, [ ((-),1,2) ] )
-    , ( const True, [ ((+),0,2) ] )
-    , ( const True, [ ((-),1,0) ] )
-    ]
-
-relXsdIntegerProd :: DatatypeRel Integer
-relXsdIntegerProd = mkIntRel3 "prod" (const True)
-    [ ( const True, [ ((*),1,2) ] )
-    , ( const True, [ (div,0,2) ] )
-    , ( const True, [ (div,0,1) ] )
-    ]
-
-relXsdIntegerDivMod :: DatatypeRel Integer
-relXsdIntegerDivMod = mkIntRel3 "divmod" (const True)
-    [ ( const True, [ (div,2,3) ] )
-    , ( const True, [ (mod,2,3) ] )
-    , ( const True, [ ] )
-    , ( const True, [ ] )
-    ]
-
-relXsdIntegerPower :: DatatypeRel Integer
-relXsdIntegerPower = mkIntRel3maybe "power" (const True)
-    [ ( const True, [ (liftM (:[]) `c2` intPower,1,2) ] )
-    , ( const True, [ ] )
-    , ( (>=0),      [ ] )
-    ]
-
-liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool
-liftL2 p i1 i2 as = p (i1 as) (i2 as)
-
-lcomp :: (a->a->Bool) -> [a] -> Bool
-lcomp p = liftL2 p head (head . tail)
-
--- eq
-
-relXsdIntegerEq :: DatatypeRel Integer
-relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==))
-    ( repeat (const True, []) )
-
--- ne
-
-relXsdIntegerNe :: DatatypeRel Integer
-relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=))
-    ( repeat (const True, []) )
-
--- lt
-
-relXsdIntegerLt :: DatatypeRel Integer
-relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<))
-    ( repeat (const True, []) )
-
--- le
-
-relXsdIntegerLe :: DatatypeRel Integer
-relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=))
-    ( repeat (const True, []) )
-
--- gt
-
-relXsdIntegerGt :: DatatypeRel Integer
-relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>))
-    ( repeat (const True, []) )
-
--- ge
-
-relXsdIntegerGe :: DatatypeRel Integer
-relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=))
-    ( repeat (const True, []) )
-
--- |modXsdInteger contains variable binding modifiers for xsd:Integer values.
---
---  The functions are selected from those defined by CWM as math:
---  properties.
---  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)
---
-modXsdInteger :: [RDFDatatypeMod Integer]
-modXsdInteger =
-    [ modXsdIntegerAbs
-    , modXsdIntegerNeg
-    , modXsdIntegerSum
-    , modXsdIntegerDiff
-    , modXsdIntegerProd
-    , modXsdIntegerDivMod
-    , modXsdIntegerPower
-    , modXsdIntegerEq
-    , modXsdIntegerNe
-    , modXsdIntegerLt
-    , modXsdIntegerLe
-    , modXsdIntegerGt
-    , modXsdIntegerGe
-    ]
-
-modXsdIntegerAbs :: RDFDatatypeMod Integer
-modXsdIntegerAbs = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "abs")
-    , dmModf = [ f0, f1 ]
-    , dmAppf = makeVmod_1_1
-    }
-    where
-        f0 vs@[v1,v2] = if v1 == abs v2 then vs else []
-        f0 _          = []
-        f1 [v2]       = [abs v2]
-        f1 _          = []
-
-modXsdIntegerNeg :: RDFDatatypeMod Integer
-modXsdIntegerNeg = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "neg")
-    , dmModf = [ f0, f1, f1 ]
-    , dmAppf = makeVmod_1_1_inv
-    }
-    where
-        f0 vs@[v1,v2] = if v1 == negate v2 then vs else []
-        f0 _          = []
-        f1 [vi]       = [-vi]
-        f1 _          = []
-
-modXsdIntegerSum :: RDFDatatypeMod Integer
-modXsdIntegerSum = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "sum")
-    , dmModf = [ f0, f1, f2, f2 ]
-    , dmAppf = makeVmod_2_1_inv
-    }
-    where
-        f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []
-        f0 _             = []
-        f1 [v2,v3]       = [v2+v3]
-        f1 _             = []
-        f2 [v1,vi]       = [v1-vi]
-        f2 _             = []
-
-modXsdIntegerDiff :: RDFDatatypeMod Integer
-modXsdIntegerDiff = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "diff")
-    , dmModf = [ f0, f1, f2, f3 ]
-    , dmAppf = makeVmod_2_1_inv
-    }
-    where
-        f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []
-        f0 _             = []
-        f1 [v2,v3]       = [v2-v3]
-        f1 _             = []
-        f2 [v1,v3]       = [v1+v3]
-        f2 _             = []
-        f3 [v1,v2]       = [v2-v1]
-        f3 _             = []
-
-modXsdIntegerProd :: RDFDatatypeMod Integer
-modXsdIntegerProd = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "prod")
-    , dmModf = [ f0, f1, f2, f2 ]
-    , dmAppf = makeVmod_2_1_inv
-    }
-    where
-        f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []
-        f0 _             = []
-        f1 [v2,v3]       = [v2*v3]
-        f1 _             = []
-        f2 [v1,vi]       = if r == 0 then [q] else []
-            where (q,r)  = quotRem v1 vi
-        f2 _             = []
-
-modXsdIntegerDivMod :: RDFDatatypeMod Integer
-modXsdIntegerDivMod = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "divmod")
-    , dmModf = [ f0, f1 ]
-    , dmAppf = makeVmod_2_2
-    }
-    where
-        f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else []
-        f0 _                = []
-        f1 [v3,v4]          = [v1,v2] where (v1,v2) = divMod v3 v4
-        f1 _                = []
-
-modXsdIntegerPower :: RDFDatatypeMod Integer
-modXsdIntegerPower = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger "power")
-    , dmModf = [ f0, f1 ]
-    , dmAppf = makeVmod_2_1
-    }
-    where
-        f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else []
-        f0 _             = []
-        f1 [v2,v3]       = maybeToList (intPower v2 v3)
-        f1 _             = []
-
-modXsdIntegerEq = modXsdIntegerCompare "eq" (==)
-modXsdIntegerNe = modXsdIntegerCompare "ne" (/=)
-modXsdIntegerLt = modXsdIntegerCompare "lt" (<)
-modXsdIntegerLe = modXsdIntegerCompare "le" (<=)
-modXsdIntegerGt = modXsdIntegerCompare "gt" (>)
-modXsdIntegerGe = modXsdIntegerCompare "ge" (>=)
-
-modXsdIntegerCompare ::
-    String -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer
-modXsdIntegerCompare nam rel = DatatypeMod
-    { dmName = (ScopedName namespaceXsdInteger nam)
-    , dmModf = [ f0 ]
-    , dmAppf = makeVmod_2_0
-    }
-    where
-        f0 vs@[v1,v2] = if rel v1 v2 then vs else []
-        f0 _          = []
-
--- |rulesetXsdInteger contains rules and axioms that allow additional
---  deductions when xsd:integer values appear in a graph.
---
---  The rules defined here are concerned with basic integer arithmetic
---  operations: +, -, *, div, rem
---
---  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
---
-rdfRulesetXsdInteger =
-    makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger
-
-mkPrefix ns =
-    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"
-
-prefixXsdInteger =
-    mkPrefix namespaceRDF  ++
-    mkPrefix namespaceRDFS ++
-    mkPrefix namespaceRDFD ++
-    mkPrefix namespaceXSD  ++
-    mkPrefix namespaceXsdInteger ++
-    " \n"
-
-mkAxiom :: String -> String -> RDFFormula
-mkAxiom local gr =
-    makeRDFFormula namespaceXsdInteger local (prefixXsdInteger++gr)
-
-axiomsXsdInteger =
-    [ mkAxiom "dt"      "xsd:integer rdf:type rdfs:Datatype ."
-    ]
-
-rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr
-    where
-        gr = makeRDFGraphFromN3String rulesXsdIntegerStr
-
-rulesXsdIntegerStr = prefixXsdInteger
-    +++ "xsd_integer:Abs a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:abs ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Neg a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:neg ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Sum a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
-    +++ "  rdfd:constraint xsd_integer:sum ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Diff a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
-    +++ "  rdfd:constraint xsd_integer:diff ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Prod a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
-    +++ "  rdfd:constraint xsd_integer:prod ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:DivMod a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "
-    +++ "  rdfd:constraint xsd_integer:divmod ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Power a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
-    +++ "  rdfd:constraint xsd_integer:power ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Eq a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:eq ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Ne a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:ne ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Lt a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:lt ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Le a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:le ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Gt a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:gt ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_integer:Ge a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_integer:ge ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdInteger.hs,v $
--- $Author: graham $
--- $Revision: 1.15 $
--- $Log: RDFDatatypeXsdInteger.hs,v $
--- Revision 1.15  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.14  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.13  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.12  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.11  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.10  2003/11/27 11:35:49  graham
--- Variable modifier tests all run.
--- Initial class constraint reasoning tests pass.
--- Fixed bug in class constraint backward-chained reasoning that returned
--- multiple instances of some statements, and did not filter out all occurrences
--- of the original statements.
---
--- Revision 1.9  2003/11/25 23:02:17  graham
--- Reworked datatype variable modifier logic.
--- Limited range of test cases so far all pass.
---
--- Revision 1.8  2003/11/24 22:13:09  graham
--- Working on reworking datatype variable modifiers to work with
--- revised datatype framework.
---
--- Revision 1.7  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.6  2003/11/14 21:48:34  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.5  2003/11/14 15:59:51  graham
--- Separate MapXsdInteger from RDFDatatypeXsdInteger.
---
--- Revision 1.4  2003/11/11 21:02:55  graham
--- Working on datatype class-constraint inference rule.  Incomplete.
---
--- Revision 1.3  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.2  2003/10/24 21:05:08  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.1  2003/10/22 16:19:34  graham
--- DatatypeXsdInteger module renamed to RDFDatatypeXsdInteger.
---
--- Revision 1.2  2003/10/22 15:47:46  graham
--- Working on datatype inference support.
---
--- Revision 1.1  2003/10/09 17:16:59  graham
--- Add initial attempt at xsd:integer datatype module
---
− Swish/HaskellRDF/RDFDatatypeXsdIntegerTest.hs 
@@ -1,1667 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFDatatypeXsdIntegerTest.hs,v 1.13 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFDatatypeXsdIntegerTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for variable binding values and
---  variable binding modifier values.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUT module Swish.HaskellRDF.RDFDatatypeXsdIntegerTest where
-
-import Swish.HaskellRDF.RDFDatatypeXsdInteger
-    ( rdfDatatypeXsdInteger
-    , rdfDatatypeValXsdInteger
-    , typeNameXsdInteger, namespaceXsdInteger
-    , axiomsXsdInteger, rulesXsdInteger
-    , prefixXsdInteger
-    )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype
-    , RDFDatatypeVal
-    , RDFDatatypeMod
-    , applyRDFDatatypeMod
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..), RDFGraph
-    )
-
-import Swish.HaskellRDF.ClassRestrictionRule
-    ( ClassRestriction(..), ClassRestrictionFn
-    , makeDatatypeRestriction, makeDatatypeRestrictionFn
-    , makeRDFClassRestrictionRules
-    , makeRDFDatatypeRestrictionRules
-    , falseGraph, falseGraphStr
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( Datatype(..)
-    , typeName, typeRules, typeMkRules
-    , getTypeAxiom, getTypeRule
-    , DatatypeVal(..)
-    , getDTMod
-    , DatatypeMap(..)
-    , DatatypeMod(..)
-    , nullDatatypeMod
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    , getRulesetAxiom, getRulesetRule
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..)
-    , nullScope, nullFormula, nullRule
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , makeVarBinding
-    , VarBindingModify(..)
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI
-    , makeScopedName
-    , matchName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceNull
-    , namespaceRDF
-    , namespaceRDFS
-    , namespaceXSD
-    , namespaceMATH
-    , namespaceXsdType
-    , namespaceDefault
-    , scopeRDF
-    , scopeRDFS
-    , scopeRDFD
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , mapFind, mapFindMaybe
-    )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , Assertion
-    , assertBool, assertEqual, assertString, assertFailure
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Control.Monad ( unless )
-
-import Data.List
-    ( sort, union, intersect )
-
-import Data.Maybe
-    ( isJust, fromJust, fromMaybe )
-
-
-------------------------------------------------------------
---  Test case helpers
-------------------------------------------------------------
-
-assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
-assertMember preface expected actual =
-  unless (expected `elem` actual ) (assertFailure msg)
-  where msg = (if null preface then "" else preface ++ "\n") ++
-             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
-
-test :: String -> Bool -> Test
-test lab bv =
-    TestCase ( assertBool ("test:"++lab) bv )
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
-testElem lab a1 as =
-    TestCase ( assertMember ("testElem:"++lab) a1 as )
-
-testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
-testLe lab eq a1 a2 =
-    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
-
--- Test for Just x or Nothing
-
-testJust :: String -> Maybe a -> Test
-testJust lab av =
-    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
-
-testNothing :: String -> Maybe a -> Test
-testNothing lab av =
-    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
-
--- Compare lists and lists of lists and Maybe lists for set equivalence:
-
-data ListTest a = ListTest [a]
-
-instance (Eq a) => Eq (ListTest a) where
-    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
-
-instance (Show a) => Show (ListTest a) where
-    show (ListTest a) = show a
-
-data MaybeListTest a = MaybeListTest (Maybe [a])
-
-instance (Eq a) => Eq (MaybeListTest a) where
-    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
-    MaybeListTest Nothing   == MaybeListTest Nothing   = True
-    _                       == _                       = False
-
-instance (Show a) => Show (MaybeListTest a) where
-    show (MaybeListTest a) = show a
-
-testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
-
-testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
-testEqvEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest $ map ListTest a1
-        ma2 = ListTest $ map ListTest a2
-
-testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
-testHasEqv lab a1 a2 =
-    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest a1
-        ma2 = map ListTest a2
-
-testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
-testMaybeEqv lab a1 a2 =
-    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = (MaybeListTest a1)
-        ma2 = (MaybeListTest a2)
-
-------------------------------------------------------------
---  Misc values
-------------------------------------------------------------
-
-xsd_int_name nam  = (ScopedName namespaceXsdInteger nam)
-
-axiomXsdIntegerDT       = xsd_int_name "dt"
-
-ruleXsdIntegerAbs       = xsd_int_name "Abs"
-ruleXsdIntegerNeg       = xsd_int_name "Neg"
-ruleXsdIntegerSum       = xsd_int_name "Sum"
-ruleXsdIntegerDiff      = xsd_int_name "Diff"
-ruleXsdIntegerProd      = xsd_int_name "Prod"
-ruleXsdIntegerDivMod    = xsd_int_name "DivMod"
-ruleXsdIntegerPower     = xsd_int_name "Power"
-ruleXsdIntegerEq        = xsd_int_name "Eq"
-ruleXsdIntegerNe        = xsd_int_name "Ne"
-ruleXsdIntegerLt        = xsd_int_name "Lt"
-ruleXsdIntegerLe        = xsd_int_name "Le"
-ruleXsdIntegerGt        = xsd_int_name "Gt"
-ruleXsdIntegerGe        = xsd_int_name "Ge"
-
-------------------------------------------------------------
---  Basic rdfDatatypeXsdInteger tests
-------------------------------------------------------------
-
-getXsdIntegerAxiom scopnam =
-    fromMaybe nullFormula $ getTypeAxiom scopnam rdfDatatypeXsdInteger
-
-getXsdIntegerRule scopnam =
-    fromMaybe nullRule $ getTypeRule scopnam rdfDatatypeXsdInteger
-
-getXsdIntegerDTmod scopnam =
-    fromMaybe nullDatatypeMod $ getDTMod scopnam rdfDatatypeValXsdInteger
-
-testDatatype01 = testEq  "testDatatype01" typeNameXsdInteger $
-                    typeName rdfDatatypeXsdInteger
-testDatatype02 = testEq  "testDatatype02" namespaceXsdInteger $
-                    rsNamespace (typeRules rdfDatatypeXsdInteger)
-testDatatype03 = testEqv "testDatatype03" axiomsXsdInteger $
-                    rsAxioms (typeRules rdfDatatypeXsdInteger)
-testDatatype04 = testEqv "testDatatype04" rulesXsdInteger $
-                    rsRules (typeRules rdfDatatypeXsdInteger)
-testDatatype05 = testEq "testDatatype05" axiomXsdIntegerDT $
-                    formName (getXsdIntegerAxiom axiomXsdIntegerDT)
-testDatatype06 = testEq "testDatatype06" ruleXsdIntegerAbs $
-                    ruleName (getXsdIntegerRule ruleXsdIntegerAbs)
-
-testDatatypeSuite = TestList
-    [ testDatatype01, testDatatype02, testDatatype03, testDatatype04
-    , testDatatype05, testDatatype06
-    ]
-
-------------------------------------------------------------
---  Basic rdfDatatypeValXsdInteger tests
-------------------------------------------------------------
-
-testDatatypeVal01 = testEq  "testDatatypeVal01" (Just 123) $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "123"
-testDatatypeVal02 = testEq  "testDatatypeVal02" (Just 0) $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "0"
-testDatatypeVal03 = testEq  "testDatatypeVal03" (Just 456) $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "+000456"
-testDatatypeVal04 = testEq  "testDatatypeVal04" (Just (-987)) $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "-0987"
-testDatatypeVal05 = testEq  "testDatatypeVal05" Nothing $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "11x2"
-testDatatypeVal06 = testEq  "testDatatypeVal06" Nothing $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) " 321"
-testDatatypeVal07 = testEq  "testDatatypeVal07" Nothing $
-                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "321 "
-
-testDatatypeVal11 = testEq  "testDatatypeVal11" (Just "123") $
-                        mapV2L (tvalMap rdfDatatypeValXsdInteger) 123
-testDatatypeVal12 = testEq  "testDatatypeVal12" (Just "-987") $
-                        mapV2L (tvalMap rdfDatatypeValXsdInteger) (-987)
-
-testDatatypeVal21 = testElem "testDatatypeVal21" dmodXsdIntegerAbs $
-                    map dmName (tvalMod rdfDatatypeValXsdInteger)
-testDatatypeVal22 = testEq "testDatatypeVal22" dmodXsdIntegerAbs $
-                    dmName (getXsdIntegerDTmod dmodXsdIntegerAbs)
-
-testDatatypeValSuite = TestList
-    [ testDatatypeVal01, testDatatypeVal02, testDatatypeVal03, testDatatypeVal04
-    , testDatatypeVal05, testDatatypeVal06, testDatatypeVal07
-    , testDatatypeVal11, testDatatypeVal12
-    , testDatatypeVal21, testDatatypeVal22
-    ]
-
-------------------------------------------------------------
---  Variable binding modifier tests
-------------------------------------------------------------
-
-dmodXsdIntegerAbs    = xsd_int_name "abs"
-dmodXsdIntegerNeg    = xsd_int_name "neg"
-dmodXsdIntegerSum    = xsd_int_name "sum"
-dmodXsdIntegerDiff   = xsd_int_name "diff"
-dmodXsdIntegerProd   = xsd_int_name "prod"
-dmodXsdIntegerDivMod = xsd_int_name "divmod"
-dmodXsdIntegerPower  = xsd_int_name "power"
-dmodXsdIntegerEq     = xsd_int_name "eq"
-dmodXsdIntegerNe     = xsd_int_name "ne"
-dmodXsdIntegerLt     = xsd_int_name "lt"
-dmodXsdIntegerLe     = xsd_int_name "le"
-dmodXsdIntegerGt     = xsd_int_name "gt"
-dmodXsdIntegerGe     = xsd_int_name "ge"
-
-testVmod2 = testVmodN [(Var "a"),(Var "b")]
-
-testVmod3 = testVmodN [(Var "a"),(Var "b"),(Var "c")]
-
-testVmod4 = testVmodN [(Var "a"),(Var "b"),(Var "c"),(Var "d")]
-
-testVmodN :: [RDFLabel]
-    -> String -> Maybe (RDFDatatypeMod Integer)
-    -> [RDFVarBinding] -> [RDFVarBinding]
-    -> Test
-testVmodN vars lab (Just dmod) ibinds obinds =
-    testEqv lab obinds $
-        applyRDFDatatypeMod rdfDatatypeValXsdInteger dmod vars ibinds
-testVmodN vars lab Nothing ibinds obinds = TestCase $
-    assertFailure $ "testVmodN:"++lab++", null variable binding modifier"
-
---  make various kinds of RDF variable bindings
-rdfVR (v,u) = (Var v,Res u)                     -- (Variable,Resource)
-rdfVB (v,b) = (Var v,Blank b)                   -- (Variable,Blank)
-rdfVL (v,l) = (Var v,Lit l Nothing)             -- (Variable,Untyped literal)
-rdfVI (v,l) = (Var v,Lit l (Just typeNameXsdInteger))
-                                                -- (Variable,Integer literal)
-
-makeBVR :: [(String,ScopedName)] -> RDFVarBinding
-makeBVR nls = makeVarBinding $ map rdfVR nls
-
-makeBVB :: [(String,String)] -> RDFVarBinding
-makeBVB nls = makeVarBinding $ map rdfVB nls
-
-makeBVI :: [(String,String)] -> RDFVarBinding
-makeBVI nls = makeVarBinding $ map rdfVI nls
-
-makeBVL :: [(String,String)] -> RDFVarBinding
-makeBVL nls = makeVarBinding $ map rdfVL nls
-
---  Test null modifier
-
-testVarModify00 = testVmod2  "testVarModify00"
-                    (Just nullDatatypeMod)
-                    [makeBVI [("a","123")]]
-                    [makeBVI [("a","123")]]
-
---  Tests for xsd_integer:abs
-
-testVarModifyAbs01 = testVmod2  "testVarModifyAbs01"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","123")]]
-                    [makeBVI [("a","123"),("b","123")]]
-
-testVarModifyAbs02 = testVmod2  "testVarModifyAbs02"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","-123")]]
-                    [makeBVI [("a","123"),("b","-123")]]
-
-testVarModifyAbs03 = testVmod2  "testVarModifyAbs03"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","123"),("b","123")]]
-                    [makeBVI [("a","123"),("b","123")]]
-
-testVarModifyAbs04 = testVmod2  "testVarModifyAbs04"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","123"),("b","-123")]]
-                    [makeBVI [("a","123"),("b","-123")]]
-
-testVarModifyAbs05 = testVmod2  "testVarModifyAbs05"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-123"),("b","123")]]
-                    []
-
-testVarModifyAbs06 = testVmod2  "testVarModifyAbs06"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","123"),("b","456")]]
-                    []
-
-testVarModifyAbs07 = testVmod2  "testVarModifyAbs07"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVI [("c","123")]]
-                    []
-
-testVarModifyAbs08 = testVmod2  "testVarModifyAbs08"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVL [("b","123")]]
-                    []
-
-testVarModifyAbs09 = testVmod2  "testVarModifyAbs09"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVR [("b",makeScopedName "" "http://ex.org/" "123")]]
-                    []
-
-testVarModifyAbs10 = testVmod2  "testVarModifyAbs10"
-                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
-                    [makeBVB [("b","123")]]
-                    []
-
---  Tests for xsd_integer:neg
-
-testVarModifyNeg01 = testVmod2  "testVarModifyNeg01"
-                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","123"),("b","-123")]]
-                    [makeBVI [("a","123"),("b","-123")]]
-
-testVarModifyNeg02 = testVmod2  "testVarModifyNeg02"
-                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-123"),("b","123")]]
-                    [makeBVI [("a","-123"),("b","123")]]
-
-testVarModifyNeg03 = testVmod2  "testVarModifyNeg03"
-                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","123"),("b","123")]]
-                    []
-
-testVarModifyNeg04 = testVmod2  "testVarModifyNeg04"
-                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","123")]]
-                    [makeBVI [("a","-123"),("b","123")]]
-
-testVarModifyNeg05 = testVmod2  "testVarModifyNeg05"
-                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-123")]]
-                    [makeBVI [("a","-123"),("b","123")]]
-
---  Tests for xsd_integer:sum
-
-testVarModifySum01 = testVmod3  "testVarModifySum01"
-                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","33"),("b","22"),("c","11")]]
-                    [makeBVI [("a","33"),("b","22"),("c","11")]]
-
-testVarModifySum02 = testVmod3  "testVarModifySum02"
-                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","22"),("c","11")]]
-                    [makeBVI [("a","33"),("b","22"),("c","11")]]
-
-testVarModifySum03 = testVmod3  "testVarModifySum03"
-                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","33"),("c","11")]]
-                    [makeBVI [("a","33"),("b","22"),("c","11")]]
-
-testVarModifySum04 = testVmod3  "testVarModifySum04"
-                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","33"),("b","22")]]
-                    [makeBVI [("a","33"),("b","22"),("c","11")]]
-
-testVarModifySum05 = testVmod3  "testVarModifySum05"
-                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","44"),("b","22"),("c","11")]]
-                    []
-
---  Tests for xsd_integer:diff
-
-testVarModifyDiff01 = testVmod3  "testVarModifyDiff01"
-                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","11"),("b","33"),("c","22")]]
-                    [makeBVI [("a","11"),("b","33"),("c","22")]]
-
-testVarModifyDiff02 = testVmod3  "testVarModifyDiff02"
-                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","33"),("c","22")]]
-                    [makeBVI [("a","11"),("b","33"),("c","22")]]
-
-testVarModifyDiff03 = testVmod3  "testVarModifyDiff03"
-                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","11"),("c","22")]]
-                    [makeBVI [("a","11"),("b","33"),("c","22")]]
-
-testVarModifyDiff04 = testVmod3  "testVarModifyDiff04"
-                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","11"),("b","33")]]
-                    [makeBVI [("a","11"),("b","33"),("c","22")]]
-
-testVarModifyDiff05 = testVmod3  "testVarModifyDiff05"
-                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","11"),("b","44"),("c","22")]]
-                    []
-
---  Tests for xsd_integer:prod
---
---  Note:   product can also be used to test if a value is
---          an exact multiple of some other.
-
-testVarModifyProd01 = testVmod3  "testVarModifyProd01"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","6"),("b","2"),("c","3")]]
-                    [makeBVI [("a","6"),("b","2"),("c","3")]]
-
-testVarModifyProd02 = testVmod3  "testVarModifyProd02"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","2"),("c","3")]]
-                    [makeBVI [("a","6"),("b","2"),("c","3")]]
-
-testVarModifyProd03 = testVmod3  "testVarModifyProd03"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","6"),("c","3")]]
-                    [makeBVI [("a","6"),("b","2"),("c","3")]]
-
-testVarModifyProd04 = testVmod3  "testVarModifyProd04"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","6"),("c","3")]]
-                    [makeBVI [("a","6"),("b","2"),("c","3")]]
-
-testVarModifyProd05 = testVmod3  "testVarModifyProd05"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","7"),("b","2"),("c","3")]]
-                    []
-
-testVarModifyProd06 = testVmod3  "testVarModifyProd06"
-                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","7"),("b","2")]]
-                    []
-
---  Tests for xsd_integer:divmod
---
---  Note:   truncates downwards, so remainder is same sign as divisor
---          cf. Haskell divMod function.
-
-testVarModifyDivMod01 = testVmod4  "testVarModifyDivMod01"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
-                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
-
-testVarModifyDivMod02 = testVmod4  "testVarModifyDivMod02"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("c","7"),("d","3")]]
-                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
-
-testVarModifyDivMod03 = testVmod4  "testVarModifyDivMod03"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("c","-7"),("d","3")]]
-                    [makeBVI [("a","-3"),("b","2"),("c","-7"),("d","3")]]
-
-testVarModifyDivMod04 = testVmod4  "testVarModifyDivMod04"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("c","7"),("d","-3")]]
-                    [makeBVI [("a","-3"),("b","-2"),("c","7"),("d","-3")]]
-
-testVarModifyDivMod05 = testVmod4  "testVarModifyDivMod05"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("c","-7"),("d","-3")]]
-                    [makeBVI [("a","2"),("b","-1"),("c","-7"),("d","-3")]]
-
-testVarModifyDivMod06 = testVmod4  "testVarModifyDivMod06"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","2"),("b","5"),("c","7"),("d","3")]]
-                    []
-
-testVarModifyDivMod07 = testVmod4  "testVarModifyDivMod07"
-                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","2"),("b","1"),("d","3")]]
-                    []
-
---  Tests for xsd_integer:power
-
-testVarModifyPower01 = testVmod3  "testVarModifyPower01"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","8"),("b","2"),("c","3")]]
-                    [makeBVI [("a","8"),("b","2"),("c","3")]]
-
-testVarModifyPower02 = testVmod3  "testVarModifyPower02"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","2"),("c","3")]]
-                    [makeBVI [("a","8"),("b","2"),("c","3")]]
-
-testVarModifyPower03 = testVmod3  "testVarModifyPower03"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","8"),("c","3")]]
-                    []
-
-testVarModifyPower04 = testVmod3  "testVarModifyPower04"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","8"),("b","2")]]
-                    []
-
-testVarModifyPower05 = testVmod3  "testVarModifyPower05"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","8"),("b","3"),("c","2")]]
-                    []
-
-testVarModifyPower06 = testVmod3  "testVarModifyPower06"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","55"),("c","0")]]
-                    [makeBVI [("a","1"),("b","55"),("c","0")]]
-
-testVarModifyPower07 = testVmod3  "testVarModifyPower07"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","-2"),("c","3")]]
-                    [makeBVI [("a","-8"),("b","-2"),("c","3")]]
-
-testVarModifyPower08 = testVmod3  "testVarModifyPower08"
-                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","55"),("c","-2")]]
-                    []
-
---  Tests for xsd_integer:eq
-
-testVarModifyEq01 = testVmod2  "testVarModifyEq01"
-                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    [makeBVI [("a","100"),("b","100")]]
-
-testVarModifyEq02 = testVmod2  "testVarModifyEq02"
-                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    []
-
-testVarModifyEq03 = testVmod2  "testVarModifyEq03"
-                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    []
-
-testVarModifyEq04 = testVmod2  "testVarModifyEq04"
-                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyEq05 = testVmod2  "testVarModifyEq05"
-                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Tests for xsd_integer:ne
-
-testVarModifyNe01 = testVmod2  "testVarModifyNe01"
-                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    []
-
-testVarModifyNe02 = testVmod2  "testVarModifyNe02"
-                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    [makeBVI [("a","99"),("b","100")]]
-
-testVarModifyNe03 = testVmod2  "testVarModifyNe03"
-                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    [makeBVI [("a","-99"),("b","-100")]]
-
-testVarModifyNe04 = testVmod2  "testVarModifyNe04"
-                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyNe05 = testVmod2  "testVarModifyNe05"
-                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Tests for xsd_integer:lt
-
-testVarModifyLt01 = testVmod2  "testVarModifyLt01"
-                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    []
-
-testVarModifyLt02 = testVmod2  "testVarModifyLt02"
-                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    [makeBVI [("a","99"),("b","100")]]
-
-testVarModifyLt03 = testVmod2  "testVarModifyLt03"
-                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    []
-
-testVarModifyLt04 = testVmod2  "testVarModifyLt04"
-                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyLt05 = testVmod2  "testVarModifyLt05"
-                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Tests for xsd_integer:le
-
-testVarModifyLe01 = testVmod2  "testVarModifyLe01"
-                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    [makeBVI [("a","100"),("b","100")]]
-
-testVarModifyLe02 = testVmod2  "testVarModifyLe02"
-                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    [makeBVI [("a","99"),("b","100")]]
-
-testVarModifyLe03 = testVmod2  "testVarModifyLe03"
-                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    []
-
-testVarModifyLe04 = testVmod2  "testVarModifyLe04"
-                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyLe05 = testVmod2  "testVarModifyLe05"
-                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Tests for xsd_integer:gt
-
-testVarModifyGt01 = testVmod2  "testVarModifyGt01"
-                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    []
-
-testVarModifyGt02 = testVmod2  "testVarModifyGt02"
-                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    []
-
-testVarModifyGt03 = testVmod2  "testVarModifyGt03"
-                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    [makeBVI [("a","-99"),("b","-100")]]
-
-testVarModifyGt04 = testVmod2  "testVarModifyGt04"
-                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyGt05 = testVmod2  "testVarModifyGt05"
-                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Tests for xsd_integer:ge
-
-testVarModifyGe01 = testVmod2  "testVarModifyGe01"
-                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100"),("b","100")]]
-                    [makeBVI [("a","100"),("b","100")]]
-
-testVarModifyGe02 = testVmod2  "testVarModifyGe02"
-                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","99"),("b","100")]]
-                    []
-
-testVarModifyGe03 = testVmod2  "testVarModifyGe03"
-                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","-99"),("b","-100")]]
-                    [makeBVI [("a","-99"),("b","-100")]]
-
-testVarModifyGe04 = testVmod2  "testVarModifyGe04"
-                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
-                    [makeBVI [("b","100")]]
-                    []
-
-testVarModifyGe05 = testVmod2  "testVarModifyGe05"
-                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
-                    [makeBVI [("a","100")]]
-                    []
-
---  Full suite for variable binding modifier tests
-
-testVarModifySuite = TestList
-    [ testVarModify00
-    , testVarModifyAbs01,    testVarModifyAbs02,    testVarModifyAbs03
-    , testVarModifyAbs04,    testVarModifyAbs05,    testVarModifyAbs06
-    , testVarModifyAbs07,    testVarModifyAbs08,    testVarModifyAbs09
-    , testVarModifyAbs10
-    , testVarModifyNeg01,    testVarModifyNeg02,    testVarModifyNeg03
-    , testVarModifyNeg04,    testVarModifyNeg05
-    , testVarModifySum01,    testVarModifySum02,    testVarModifySum03
-    , testVarModifySum04,    testVarModifySum05
-    , testVarModifyDiff01,   testVarModifyDiff02,   testVarModifyDiff03
-    , testVarModifyDiff04,   testVarModifyDiff05
-    , testVarModifyProd01,   testVarModifyProd02,   testVarModifyProd03
-    , testVarModifyProd04,   testVarModifyProd05,   testVarModifyProd06
-    , testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03
-    , testVarModifyDivMod04, testVarModifyDivMod05, testVarModifyDivMod06
-    , testVarModifyDivMod07
-    , testVarModifyPower01,  testVarModifyPower02,  testVarModifyPower03
-    , testVarModifyPower04,  testVarModifyPower05,  testVarModifyPower06
-    , testVarModifyPower07,  testVarModifyPower08
-    , testVarModifyEq01,     testVarModifyEq02,     testVarModifyEq03
-    , testVarModifyEq04,     testVarModifyEq05
-    , testVarModifyNe01,     testVarModifyNe02,     testVarModifyNe03
-    , testVarModifyNe04,     testVarModifyNe05
-    , testVarModifyLt01,     testVarModifyLt02,     testVarModifyLt03
-    , testVarModifyLt04,     testVarModifyLt05
-    , testVarModifyLe01,     testVarModifyLe02,     testVarModifyLe03
-    , testVarModifyLe04,     testVarModifyLe05
-    , testVarModifyGt01,     testVarModifyGt02,     testVarModifyGt03
-    , testVarModifyGt04,     testVarModifyGt05
-    , testVarModifyGe01,     testVarModifyGe02,     testVarModifyGe03
-    , testVarModifyGe04,     testVarModifyGe05
-    ]
-
-------------------------------------------------------------
---  Test rules defined for datatype
-------------------------------------------------------------
-
-mkGraph grstr = makeRDFGraphFromN3String (prefixXsdInteger++base++grstr)
-    where
-        base = "@prefix : <"++nsURI namespaceDefault++"> . \n"
-
-testRuleFwd lab (Just rule) antstr constrs =
-    let
-        antgr  = mkGraph antstr
-        congrs = map mkGraph constrs
-    in
-        testEqv lab congrs $ fwdApply rule [antgr]
-testRuleFwd lab Nothing _ _ = TestCase $
-    assertFailure $ "testRuleFwd:"++lab++", null rule supplied"
-
-testRuleBwd lab (Just rule) antstr prestrss =
-    let
-        antgr   = mkGraph antstr
-        pregrss = map (map mkGraph) prestrss
-    in
-        testEqvEqv lab pregrss $ bwdApply rule antgr
-testRuleBwd lab Nothing _ _ = TestCase $
-    assertFailure $ "testRuleBwd:"++lab++", null rule supplied"
-
-testRuleChk lab (Just rule) antstr constr =
-    let
-        antgr = mkGraph antstr
-        congr = mkGraph constr
-    in
-        test lab $ checkInference rule [antgr] congr
-testRuleChk lab Nothing _ _ = TestCase $
-    assertFailure $ "testRuleChk:"++lab++", null rule supplied"
-
-xsdIntRules = (typeRules rdfDatatypeXsdInteger)
-
-axdt        = getRulesetAxiom axiomXsdIntegerDT      xsdIntRules
-
-ruleabs     = getRulesetRule  ruleXsdIntegerAbs      xsdIntRules
-ruleneg     = getRulesetRule  ruleXsdIntegerNeg      xsdIntRules
-rulesum     = getRulesetRule  ruleXsdIntegerSum      xsdIntRules
-rulediff    = getRulesetRule  ruleXsdIntegerDiff     xsdIntRules
-ruleprod    = getRulesetRule  ruleXsdIntegerProd     xsdIntRules
-ruledivmod  = getRulesetRule  ruleXsdIntegerDivMod   xsdIntRules
-rulepower   = getRulesetRule  ruleXsdIntegerPower    xsdIntRules
-ruleeq      = getRulesetRule  ruleXsdIntegerEq       xsdIntRules
-rulene      = getRulesetRule  ruleXsdIntegerNe       xsdIntRules
-rulelt      = getRulesetRule  ruleXsdIntegerLt       xsdIntRules
-rulele      = getRulesetRule  ruleXsdIntegerLe       xsdIntRules
-rulegt      = getRulesetRule  ruleXsdIntegerGt       xsdIntRules
-rulege      = getRulesetRule  ruleXsdIntegerGe       xsdIntRules
-
--- Test cases for the arithmetic functions
-
--- abs
-
-abs01inp =
-        "_:a a xsd_integer:Abs ; "
-    +++ "  rdf:_2 \"1\"^^xsd:integer . "
-abs01fwd =
-    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
-abs01bwd = []
-testRuleFwdAbs01 = testRuleFwd "testRuleFwdAbs01" ruleabs abs01inp abs01fwd
-testRuleBwdAbs01 = testRuleBwd "testRuleBwdAbs01" ruleabs abs01inp abs01bwd
-
-abs02inp =
-        "_:a a xsd_integer:Abs ; "
-    +++ "  rdf:_2 \"-1\"^^xsd:integer . "
-abs02fwd =
-    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
-abs02bwd =
-    []
-testRuleFwdAbs02 = testRuleFwd "testRuleFwdAbs02" ruleabs abs02inp abs02fwd
-testRuleBwdAbs02 = testRuleBwd "testRuleBwdAbs02" ruleabs abs02inp abs02bwd
-
-abs03inp =
-        "_:a a xsd_integer:Abs ; "
-    +++ "  rdf:_1 \"1\"^^xsd:integer . "
-abs03fwd = []
-abs03bwd =
-    [ [ "_:a a xsd_integer:Abs . "
-      , "_:a rdf:_2 \"1\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Abs . "
-      , "_:a rdf:_2 \"-1\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdAbs03 = testRuleFwd "testRuleFwdAbs03" ruleabs abs03inp abs03fwd
-testRuleBwdAbs03 = testRuleBwd "testRuleBwdAbs03" ruleabs abs03inp abs03bwd
-
-abs04inp =
-        "_:a a xsd_integer:Abs ; "
-    +++ "  rdf:_1 \"-1\"^^xsd:integer . "
-abs04fwd =
-    [ falseGraphStr
-    ]
-abs04bwd =
-    [ [ falseGraphStr
-      ]
-    ]
-testRuleFwdAbs04 = testRuleFwd "testRuleFwdAbs04" ruleabs abs04inp abs04fwd
-testRuleBwdAbs04 = testRuleBwd "testRuleBwdAbs04" ruleabs abs04inp abs04bwd
-
--- neg
-
-neg01inp =
-        "_:a a xsd_integer:Neg ; "
-    +++ "  rdf:_2 \"1\"^^xsd:integer . "
-neg01fwd =
-    [ "_:a rdf:_1 \"-1\"^^xsd:integer . " ]
-neg01bwd =
-    [ [ "_:a a xsd_integer:Neg . "
-      , "_:a rdf:_1 \"-1\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdNeg01 = testRuleFwd "testRuleFwdNeg01" ruleneg neg01inp neg01fwd
-testRuleBwdNeg01 = testRuleBwd "testRuleBwdNeg01" ruleneg neg01inp neg01bwd
-
-neg02inp =
-        "_:a a xsd_integer:Neg ; "
-    +++ "  rdf:_2 \"-2\"^^xsd:integer . "
-neg02fwd =
-    [ "_:a rdf:_1 \"2\"^^xsd:integer . " ]
-neg02bwd =
-    [ [ "_:a a xsd_integer:Neg . "
-      , "_:a rdf:_1 \"2\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdNeg02 = testRuleFwd "testRuleFwdNeg02" ruleneg neg02inp neg02fwd
-testRuleBwdNeg02 = testRuleBwd "testRuleBwdNeg02" ruleneg neg02inp neg02bwd
-
--- sum
-
-sum01inp =
-        "_:a a xsd_integer:Sum ; "
-    +++ "  rdf:_2 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"20\"^^xsd:integer . "
-sum01fwd =
-    [ "_:a rdf:_1 \"51\"^^xsd:integer . " ]
-sum01bwd =
-    [ [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_1 \"51\"^^xsd:integer . "
-      , "_:a rdf:_2 \"31\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_1 \"51\"^^xsd:integer . "
-      , "_:a rdf:_3 \"20\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdSum01 = testRuleFwd "testRuleFwdSum01" rulesum sum01inp sum01fwd
-testRuleBwdSum01 = testRuleBwd "testRuleBwdSum01" rulesum sum01inp sum01bwd
-
-sum02inp =
-        "_:a a xsd_integer:Sum ; "
-    +++ "  rdf:_1 \"52\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"21\"^^xsd:integer . "
-sum02fwd =
-    [ "_:a rdf:_2 \"31\"^^xsd:integer . " ]
-sum02bwd =
-    [ [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_1 \"52\"^^xsd:integer . "
-      , "_:a rdf:_2 \"31\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_2 \"31\"^^xsd:integer . "
-      , "_:a rdf:_3 \"21\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdSum02 = testRuleFwd "testRuleFwdSum02" rulesum sum02inp sum02fwd
-testRuleBwdSum02 = testRuleBwd "testRuleBwdSum02" rulesum sum02inp sum02bwd
-
-sum03inp =
-        "_:a a xsd_integer:Sum ; "
-    +++ "  rdf:_1 \"53\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"32\"^^xsd:integer . "
-sum03fwd =
-    [ "_:a rdf:_3 \"21\"^^xsd:integer . " ]
-sum03bwd =
-    [ [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_1 \"53\"^^xsd:integer . "
-      , "_:a rdf:_3 \"21\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Sum . "
-      , "_:a rdf:_2 \"32\"^^xsd:integer . "
-      , "_:a rdf:_3 \"21\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdSum03 = testRuleFwd "testRuleFwdSum03" rulesum sum03inp sum03fwd
-testRuleBwdSum03 = testRuleBwd "testRuleBwdSum03" rulesum sum03inp sum03bwd
-
--- diff
-
-diff01inp =
-        "_:a a xsd_integer:Diff ; "
-    +++ "  rdf:_2 \"222\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"333\"^^xsd:integer . "
-diff01fwd =
-    [ "_:a rdf:_1 \"-111\"^^xsd:integer . " ]
-diff01bwd =
-    [ [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
-      , "_:a rdf:_3 \"333\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdDiff01 = testRuleFwd "testRuleFwdDiff01" rulediff diff01inp diff01fwd
-testRuleBwdDiff01 = testRuleBwd "testRuleBwdDiff01" rulediff diff01inp diff01bwd
-
-diff02inp =
-        "_:a a xsd_integer:Diff ; "
-    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"333\"^^xsd:integer . "
-diff02fwd =
-    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]
-diff02bwd =
-    [ [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      , "_:a rdf:_3 \"333\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdDiff02 = testRuleFwd "testRuleFwdDiff02" rulediff diff02inp diff02fwd
-testRuleBwdDiff02 = testRuleBwd "testRuleBwdDiff02" rulediff diff02inp diff02bwd
-
-diff03inp =
-        "_:a a xsd_integer:Diff ; "
-    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"222\"^^xsd:integer . "
-diff03fwd =
-    [ "_:a rdf:_3 \"333\"^^xsd:integer . " ]
-diff03bwd =
-    [ [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
-      , "_:a rdf:_3 \"333\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Diff . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      , "_:a rdf:_3 \"333\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdDiff03 = testRuleFwd "testRuleFwdDiff03" rulediff diff03inp diff03fwd
-testRuleBwdDiff03 = testRuleBwd "testRuleBwdDiff03" rulediff diff03inp diff03bwd
-
--- prod
-
-prod01inp =
-        "_:a a xsd_integer:Prod ; "
-    +++ "  rdf:_2 \"222\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"3\"^^xsd:integer . "
-prod01fwd =
-    [ "_:a rdf:_1 \"666\"^^xsd:integer . " ]
-prod01bwd =
-    [ [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_1 \"666\"^^xsd:integer . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_1 \"666\"^^xsd:integer . "
-      , "_:a rdf:_3 \"3\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdProd01 = testRuleFwd "testRuleFwdProd01" ruleprod prod01inp prod01fwd
-testRuleBwdProd01 = testRuleBwd "testRuleBwdProd01" ruleprod prod01inp prod01bwd
-
-prod02inp =
-        "_:a a xsd_integer:Prod ; "
-    +++ "  rdf:_1 \"666\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"3\"^^xsd:integer . "
-prod02fwd =
-    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]
-prod02bwd =
-    [ [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_1 \"666\"^^xsd:integer . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      , "_:a rdf:_3 \"3\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdProd02 = testRuleFwd "testRuleFwdProd02" ruleprod prod02inp prod02fwd
-testRuleBwdProd02 = testRuleBwd "testRuleBwdProd02" ruleprod prod02inp prod02bwd
-
-prod03inp =
-        "_:a a xsd_integer:Prod ; "
-    +++ "  rdf:_1 \"666\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"222\"^^xsd:integer . "
-prod03fwd =
-    [ "_:a rdf:_3 \"3\"^^xsd:integer . " ]
-prod03bwd =
-    [ [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_1 \"666\"^^xsd:integer . "
-      , "_:a rdf:_3 \"3\"^^xsd:integer . "
-      ]
-    , [ "_:a a xsd_integer:Prod . "
-      , "_:a rdf:_2 \"222\"^^xsd:integer . "
-      , "_:a rdf:_3 \"3\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdProd03 = testRuleFwd "testRuleFwdProd03" ruleprod prod03inp prod03fwd
-testRuleBwdProd03 = testRuleBwd "testRuleBwdProd03" ruleprod prod03inp prod03bwd
-
--- divmod
-
-divmod01inp =
-        "_:a a xsd_integer:DivMod ; "
-    +++ "  rdf:_3 \"33\"^^xsd:integer ; "
-    +++ "  rdf:_4 \"5\"^^xsd:integer . "
-divmod01fwd =
-    [     "_:a rdf:_1 \"6\"^^xsd:integer . "
-      +++ "_:a rdf:_2 \"3\"^^xsd:integer . "
-    ]
-divmod01bwd =
-    [ {- "_:a a xsd_integer:DivMod . "
-      , "_:a rdf:_1 \"6\"^^xsd:integer . "
-      , "_:a rdf:_2 \"3\"^^xsd:integer . "
-      , "_:a rdf:_4 \"5\"^^xsd:integer . "
-      -}
-    ]
-testRuleFwdDivMod01 = testRuleFwd "testRuleFwdDivMod01" ruledivmod divmod01inp divmod01fwd
-testRuleBwdDivMod01 = testRuleBwd "testRuleBwdDivMod01" ruledivmod divmod01inp divmod01bwd
-
-divmod02inp =
-        "_:a a xsd_integer:DivMod ; "
-    +++ "  rdf:_1 \"6\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"3\"^^xsd:integer ; "
-    +++ "  rdf:_4 \"5\"^^xsd:integer . "
-divmod02fwd =
-    [ ]
-divmod02bwd =
-    [ {- "_:a a xsd_integer:DivMod . "
-      , "_:a rdf:_3 \"33\"^^xsd:integer . "
-      , "_:a rdf:_4 \"5\"^^xsd:integer . "
-      -}
-    ]
-testRuleFwdDivMod02 = testRuleFwd "testRuleFwdDivMod02" ruledivmod divmod02inp divmod02fwd
-testRuleBwdDivMod02 = testRuleBwd "testRuleBwdDivMod02" ruledivmod divmod02inp divmod02bwd
-
-divmod03inp =
-        "_:a a xsd_integer:DivMod ; "
-    +++ "  rdf:_3 \"-33\"^^xsd:integer ; "
-    +++ "  rdf:_4 \"5\"^^xsd:integer . "
-divmod03fwd =
-    [     "_:a rdf:_1 \"-7\"^^xsd:integer . "
-      +++ "_:a rdf:_2 \"2\"^^xsd:integer . "
-    ]
-divmod03bwd =
-    [ ]
-testRuleFwdDivMod03 = testRuleFwd "testRuleFwdDivMod03" ruledivmod divmod03inp divmod03fwd
-testRuleBwdDivMod03 = testRuleBwd "testRuleBwdDivMod03" ruledivmod divmod03inp divmod03bwd
-
--- power
-
-power01inp =
-        "_:a a xsd_integer:Power ; "
-    +++ "  rdf:_2 \"2\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"5\"^^xsd:integer . "
-power01fwd =
-    [ "_:a rdf:_1 \"32\"^^xsd:integer . " ]
-power01bwd =
-    [ ]
-testRuleFwdPower01 = testRuleFwd "testRuleFwdPower01" rulepower power01inp power01fwd
-testRuleBwdPower01 = testRuleBwd "testRuleBwdPower01" rulepower power01inp power01bwd
-
-power02inp =
-        "_:a a xsd_integer:Power ; "
-    +++ "  rdf:_2 \"111\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"0\"^^xsd:integer . "
-power02fwd =
-    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
-power02bwd =
-    [ ]
-testRuleFwdPower02 = testRuleFwd "testRuleFwdPower02" rulepower power02inp power02fwd
-testRuleBwdPower02 = testRuleBwd "testRuleBwdPower02" rulepower power02inp power02bwd
-
-power03inp =
-        "_:a a xsd_integer:Power ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer ; "
-    +++ "  rdf:_3 \"-33\"^^xsd:integer . "
-power03fwd =
-    [ falseGraphStr ]
-power03bwd =
-    [ [ falseGraphStr ]
-    ]
-testRuleFwdPower03 = testRuleFwd "testRuleFwdPower03" rulepower power03inp power03fwd
-testRuleBwdPower03 = testRuleBwd "testRuleBwdPower03" rulepower power03inp power03bwd
-
--- eq
-
-eq01inp =
-        "_:a a xsd_integer:Eq ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-eq01fwd = [ ]
-eq01bwd = [ ]
-testRuleFwdEq01 = testRuleFwd "testRuleFwdEq01" ruleeq eq01inp eq01fwd
-testRuleBwdEq01 = testRuleBwd "testRuleBwdEq01" ruleeq eq01inp eq01bwd
-
-eq02inp =
-        "_:a a xsd_integer:Eq ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-eq02fwd = [ falseGraphStr ]
-eq02bwd = [ [falseGraphStr] ]
-testRuleFwdEq02 = testRuleFwd "testRuleFwdEq02" ruleeq eq02inp eq02fwd
-testRuleBwdEq02 = testRuleBwd "testRuleBwdEq02" ruleeq eq02inp eq02bwd
-
-eq03inp =
-        "_:a a xsd_integer:Eq ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-eq03fwd = [ falseGraphStr ]
-eq03bwd = [ [falseGraphStr] ]
-testRuleFwdEq03 = testRuleFwd "testRuleFwdEq03" ruleeq eq03inp eq03fwd
-testRuleBwdEq03 = testRuleBwd "testRuleBwdEq03" ruleeq eq03inp eq03bwd
-
--- ne
-
-ne01inp =
-        "_:a a xsd_integer:Ne ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-ne01fwd = [ falseGraphStr ]
-ne01bwd = [ [falseGraphStr] ]
-testRuleFwdNe01 = testRuleFwd "testRuleFwdNe01" rulene ne01inp ne01fwd
-testRuleBwdNe01 = testRuleBwd "testRuleBwdNe01" rulene ne01inp ne01bwd
-
-ne02inp =
-        "_:a a xsd_integer:Ne ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-ne02fwd = [ ]
-ne02bwd = [ ]
-testRuleFwdNe02 = testRuleFwd "testRuleFwdNe02" rulene ne02inp ne02fwd
-testRuleBwdNe02 = testRuleBwd "testRuleBwdNe02" rulene ne02inp ne02bwd
-
-ne03inp =
-        "_:a a xsd_integer:Ne ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-ne03fwd = [ ]
-ne03bwd = [ ]
-testRuleFwdNe03 = testRuleFwd "testRuleFwdNe03" rulene ne03inp ne03fwd
-testRuleBwdNe03 = testRuleBwd "testRuleBwdNe03" rulene ne03inp ne03bwd
-
--- lt
-
-lt01inp =
-        "_:a a xsd_integer:Lt ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-lt01fwd = [ falseGraphStr ]
-lt01bwd = [ [falseGraphStr] ]
-testRuleFwdLt01 = testRuleFwd "testRuleFwdLt01" rulelt lt01inp lt01fwd
-testRuleBwdLt01 = testRuleBwd "testRuleBwdLt01" rulelt lt01inp lt01bwd
-
-lt02inp =
-        "_:a a xsd_integer:Lt ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-lt02fwd = [ ]
-lt02bwd = [ ]
-testRuleFwdLt02 = testRuleFwd "testRuleFwdLt02" rulelt lt02inp lt02fwd
-testRuleBwdLt02 = testRuleBwd "testRuleBwdLt02" rulelt lt02inp lt02bwd
-
-lt03inp =
-        "_:a a xsd_integer:Lt ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-lt03fwd = [ falseGraphStr ]
-lt03bwd = [ [falseGraphStr] ]
-testRuleFwdLt03 = testRuleFwd "testRuleFwdLt03" rulelt lt03inp lt03fwd
-testRuleBwdLt03 = testRuleBwd "testRuleBwdLt03" rulelt lt03inp lt03bwd
-
--- le
-
-le01inp =
-        "_:a a xsd_integer:Le ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-le01fwd = [ ]
-le01bwd = [ ]
-testRuleFwdLe01 = testRuleFwd "testRuleFwdLe01" rulele le01inp le01fwd
-testRuleBwdLe01 = testRuleBwd "testRuleBwdLe01" rulele le01inp le01bwd
-
-le02inp =
-        "_:a a xsd_integer:Le ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-le02fwd = [ ]
-le02bwd = [ ]
-testRuleFwdLe02 = testRuleFwd "testRuleFwdLe02" rulele le02inp le02fwd
-testRuleBwdLe02 = testRuleBwd "testRuleBwdLe02" rulele le02inp le02bwd
-
-le03inp =
-        "_:a a xsd_integer:Le ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-le03fwd = [ falseGraphStr ]
-le03bwd = [ [falseGraphStr] ]
-testRuleFwdLe03 = testRuleFwd "testRuleFwdLe03" rulele le03inp le03fwd
-testRuleBwdLe03 = testRuleBwd "testRuleBwdLe03" rulele le03inp le03bwd
-
--- gt
-
-gt01inp =
-        "_:a a xsd_integer:Gt ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-gt01fwd = [ falseGraphStr ]
-gt01bwd = [ [falseGraphStr] ]
-testRuleFwdGt01 = testRuleFwd "testRuleFwdGt01" rulegt gt01inp gt01fwd
-testRuleBwdGt01 = testRuleBwd "testRuleBwdGt01" rulegt gt01inp gt01bwd
-
-gt02inp =
-        "_:a a xsd_integer:Gt ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-gt02fwd = [ falseGraphStr ]
-gt02bwd = [ [falseGraphStr] ]
-testRuleFwdGt02 = testRuleFwd "testRuleFwdGt02" rulegt gt02inp gt02fwd
-testRuleBwdGt02 = testRuleBwd "testRuleBwdGt02" rulegt gt02inp gt02bwd
-
-gt03inp =
-        "_:a a xsd_integer:Gt ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-gt03fwd = [ ]
-gt03bwd = [ ]
-testRuleFwdGt03 = testRuleFwd "testRuleFwdGt03" rulegt gt03inp gt03fwd
-testRuleBwdGt03 = testRuleBwd "testRuleBwdGt03" rulegt gt03inp gt03bwd
-
--- ge
-
-ge01inp =
-        "_:a a xsd_integer:Ge ; "
-    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"11\"^^xsd:integer . "
-ge01fwd = [ ]
-ge01bwd = [ ]
-testRuleFwdGe01 = testRuleFwd "testRuleFwdGe01" rulege ge01inp ge01fwd
-testRuleBwdGe01 = testRuleBwd "testRuleBwdGe01" rulege ge01inp ge01bwd
-
-ge02inp =
-        "_:a a xsd_integer:Ge ; "
-    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"22\"^^xsd:integer . "
-ge02fwd = [ falseGraphStr ]
-ge02bwd = [ [falseGraphStr] ]
-testRuleFwdGe02 = testRuleFwd "testRuleFwdGe02" rulege ge02inp ge02fwd
-testRuleBwdGe02 = testRuleBwd "testRuleBwdGe02" rulege ge02inp ge02bwd
-
-ge03inp =
-        "_:a a xsd_integer:Ge ; "
-    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
-    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
-ge03fwd = [ ]
-ge03bwd = [ ]
-testRuleFwdGe03 = testRuleFwd "testRuleFwdGe03" rulege ge03inp ge03fwd
-testRuleBwdGe03 = testRuleBwd "testRuleBwdGe03" rulege ge03inp ge03bwd
-
--- Test cases from design notes
-
-infixr 5 +++
-(+++) :: String -> ShowS
-(+++) str = ((str++"\n")++)
-
--- Make a vector of rules using the graph string below
-
-pvRules :: [RDFRule]
--- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr
-pvRules = typeMkRules rdfDatatypeXsdInteger gr
-    where
-        gr = (mkGraph pvRulesStr)
-
-pvRulesStr =
-        ":PassengerVehicle a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "
-    +++ "  rdfd:constraint xsd_integer:sum . "
-    +++ ":PassengerVehicle1 a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "
-    +++ "  rdfd:constraint xsd_integer:sum ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-
---  Now the test cases that use the rules created above.
-
-pvRule0 = mapFindMaybe
-            (ScopedName namespaceDefault "PassengerVehicle")
-            (LookupMap pvRules)
-pvRule1 = mapFindMaybe
-            (ScopedName namespaceDefault "PassengerVehicle1")
-            (LookupMap pvRules)
-
-pv01inp =
-        "_:a a :PassengerVehicle ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :standingCapacity \"20\"^^xsd:integer . "
-pv01fwd =
-    [ "_:a :totalCapacity \"50\"^^xsd:integer . " ]
-pv01bwd =
-    [ [ "_:a a :PassengerVehicle . "
-      , "_:a :totalCapacity \"50\"^^xsd:integer . "
-      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
-      ]
-    , [ "_:a a :PassengerVehicle . "
-      , "_:a :totalCapacity \"50\"^^xsd:integer . "
-      , "_:a :standingCapacity \"20\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdPv01 = testRuleFwd "testRuleFwdPv01" pvRule0 pv01inp pv01fwd
-testRuleBwdPv01 = testRuleBwd "testRuleBwdPv01" pvRule0 pv01inp pv01bwd
-
-pv02inp =
-        "_:a a :PassengerVehicle ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"51\"^^xsd:integer . "
-    +++ "_:b a :PassengerVehicle ; "
-    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"52\"^^xsd:integer . "
-pv02fwd =
-    [ "_:a :standingCapacity \"21\"^^xsd:integer . "
-    , "_:b :seatedCapacity \"32\"^^xsd:integer . "
-    ]
-pv02bwd =
-    [ [ "_:a a :PassengerVehicle . "
-      , "_:a :standingCapacity \"21\"^^xsd:integer . "
-      , "_:a :totalCapacity \"51\"^^xsd:integer . "
-      , "_:b a :PassengerVehicle . "
-      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
-      , "_:b :totalCapacity \"52\"^^xsd:integer . "
-      ]
-    , [ "_:a a :PassengerVehicle . "
-      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
-      , "_:a :standingCapacity \"21\"^^xsd:integer . "
-      , "_:b a :PassengerVehicle . "
-      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
-      , "_:b :totalCapacity \"52\"^^xsd:integer . "
-      ]
-    , [ "_:a a :PassengerVehicle . "
-      , "_:a :standingCapacity \"21\"^^xsd:integer . "
-      , "_:a :totalCapacity \"51\"^^xsd:integer . "
-      , "_:b a :PassengerVehicle . "
-      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
-      , "_:b :standingCapacity \"20\"^^xsd:integer . "
-      ]
-    , [ "_:a a :PassengerVehicle . "
-      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
-      , "_:a :standingCapacity \"21\"^^xsd:integer . "
-      , "_:b a :PassengerVehicle . "
-      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
-      , "_:b :standingCapacity \"20\"^^xsd:integer . "
-      ]
-    ]
-testRuleFwdPv02 = testRuleFwd "testRuleFwdPv02" pvRule0 pv02inp pv02fwd
-testRuleBwdPv02 = testRuleBwd "testRuleBwdPv02" pvRule0 pv02inp pv02bwd
-
-pv03inp =
-        "_:a a :PassengerVehicle ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :standingCapacity \"23\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"53\"^^xsd:integer . "
-pv03fwd = []
-testRuleFwdPv03 = testRuleFwd "testRuleFwdPv03" pvRule0 pv03inp pv03fwd
-
-pv04inp =
-        "_:a a :PassengerVehicle ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"54\"^^xsd:integer . "
-pv04fwd =
-    [     "_:a :standingCapacity \"24\"^^xsd:integer . "
-      +++ "_:a :seatedCapacity \"34\"^^xsd:integer . "
-      +++ "_:a :totalCapacity \"50\"^^xsd:integer . "
-    ]
-testRuleFwdPv04 = testRuleFwd "testRuleFwdPv04" pvRule0 pv04inp pv04fwd
-
-pv05inp =
-        "_:a a :PassengerVehicle1 ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :standingCapacity \"25\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"55\"^^xsd:integer . "
-pv05fwd = []
-testRuleFwdPv05 = testRuleFwd "testRuleFwdPv05" pvRule1 pv05inp pv05fwd
-
-pv06inp =
-        "_:a a :PassengerVehicle1 ; "
-    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
-    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
-    +++ "  :totalCapacity \"56\"^^xsd:integer . "
-pv06fwd =
-    [ falseGraphStr
-    ]
-pv06bwd =
-    [ [ falseGraphStr
-      ]
-    ]
-testRuleFwdPv06 = testRuleFwd "testRuleFwdPv06" pvRule1 pv06inp pv06fwd
-testRuleBwdPv06 = testRuleBwd "testRuleBwdPv06" pvRule1 pv06inp pv06bwd
-
-pv07inp =
-        "_:a a :PassengerVehicle ; "
-    +++ "  :totalCapacity \"57\"^^xsd:integer . "
-pv07fwd = []
-pv07bwd = []
-testRuleFwdPv07 = testRuleFwd "testRuleFwdPv07" pvRule0 pv07inp pv07fwd
-testRuleBwdPv07 = testRuleFwd "testRuleBwdPv07" pvRule0 pv07inp pv07bwd
-
---  Full suite for datatype rule tests
-
-testDatatypeRuleSuite = TestList
-    [ testRuleFwdAbs01, testRuleFwdAbs02, testRuleFwdAbs03, testRuleFwdAbs04
-    , testRuleFwdNeg01, testRuleFwdNeg02
-    , testRuleFwdSum01, testRuleFwdSum02, testRuleFwdSum03
-    , testRuleFwdDiff01, testRuleFwdDiff02, testRuleFwdDiff03
-    , testRuleFwdProd01, testRuleFwdProd02, testRuleFwdProd03
-    , testRuleFwdDivMod01, testRuleFwdDivMod02, testRuleFwdDivMod03
-    , testRuleFwdPower01, testRuleFwdPower02, testRuleFwdPower03
-    , testRuleFwdEq01, testRuleFwdEq02, testRuleFwdEq03
-    , testRuleFwdNe01, testRuleFwdNe02, testRuleFwdNe03
-    , testRuleFwdLt01, testRuleFwdLt02, testRuleFwdLt03
-    , testRuleFwdLe01, testRuleFwdLe02, testRuleFwdLe03
-    , testRuleFwdGt01, testRuleFwdGt02, testRuleFwdGt03
-    , testRuleFwdGe01, testRuleFwdGe02, testRuleFwdGe03
-    -- backard chaining tests
-    , testRuleBwdAbs01, testRuleBwdAbs02, testRuleBwdAbs03, testRuleBwdAbs04
-    , testRuleBwdNeg01, testRuleBwdNeg02
-    , testRuleBwdSum01, testRuleBwdSum02, testRuleBwdSum03
-    , testRuleBwdDiff01, testRuleBwdDiff02, testRuleBwdDiff03
-    , testRuleBwdProd01, testRuleBwdProd02, testRuleBwdProd03
-    , testRuleBwdDivMod01, testRuleBwdDivMod02, testRuleBwdDivMod03
-    , testRuleBwdPower01, testRuleBwdPower02, testRuleBwdPower03
-    , testRuleBwdEq01, testRuleBwdEq02, testRuleBwdEq03
-    , testRuleBwdNe01, testRuleBwdNe02, testRuleBwdNe03
-    , testRuleBwdLt01, testRuleBwdLt02, testRuleBwdLt03
-    , testRuleBwdLe01, testRuleBwdLe02, testRuleBwdLe03
-    , testRuleBwdGt01, testRuleBwdGt02, testRuleBwdGt03
-    , testRuleBwdGe01, testRuleBwdGe02, testRuleBwdGe03
-    -- test cases from design notes
-    , testRuleFwdPv01, testRuleFwdPv02, testRuleFwdPv03, testRuleFwdPv04
-    , testRuleFwdPv05, testRuleFwdPv06, testRuleFwdPv07
-    , testRuleBwdPv01, testRuleBwdPv02, testRuleBwdPv06, testRuleBwdPv07
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-    [ testDatatypeSuite
-    , testDatatypeValSuite
-    , testVarModifySuite
-    , testDatatypeRuleSuite
-    ]
-
-main = runTestTT allTests
-trules = runTestTT testDatatypeRuleSuite
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdIntegerTest.hs,v $
--- $Author: graham $
--- $Revision: 1.13 $
--- $Log: RDFDatatypeXsdIntegerTest.hs,v $
--- Revision 1.13  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.12  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.11  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.10  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.9  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.8  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.7  2003/11/27 11:35:49  graham
--- Variable modifier tests all run.
--- Initial class constraint reasoning tests pass.
--- Fixed bug in class constraint backward-chained reasoning that returned
--- multiple instances of some statements, and did not filter out all occurrences
--- of the original statements.
---
--- Revision 1.6  2003/11/25 23:02:17  graham
--- Reworked datatype variable modifier logic.
--- Limited range of test cases so far all pass.
---
--- Revision 1.5  2003/11/24 22:13:09  graham
--- Working on reworking datatype variable modifiers to work with
--- revised datatype framework.
---
--- Revision 1.4  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.3  2003/11/11 21:02:55  graham
--- Working on datatype class-constraint inference rule.  Incomplete.
---
--- Revision 1.2  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.1  2003/10/24 21:05:09  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
− Swish/HaskellRDF/RDFDatatypeXsdString.hs 
@@ -1,362 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFDatatypeXsdString.hs,v 1.2 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFDatatypeXsdString
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines the structures used by swish to represent and
---  manipulate RDF xsd:string datatyped literals.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFDatatypeXsdString
-    ( rdfDatatypeXsdString
-    , rdfDatatypeValXsdString
-    , typeNameXsdString, namespaceXsdString
-    , axiomsXsdString, rulesXsdString
-    , prefixXsdString
-    )
-where
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    , makeN3ClosureRule
-    )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBindingModify
-    )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype
-    , RDFDatatypeVal
-    , RDFDatatypeMod
-    , makeRdfDtOpenVarBindingModifiers
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..) )
-
-import Swish.HaskellRDF.ClassRestrictionRule
-    ( makeRDFDatatypeRestrictionRules
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( Datatype(..)
-    , DatatypeVal(..)
-    , DatatypeMap(..)
-    , DatatypeRel(..), DatatypeRelPr
-    , altArgs
-    , UnaryFnTable,  unaryFnApp
-    , BinaryFnTable, binaryFnApp 
-    , BinMaybeFnTable, binMaybeFnApp 
-    , DatatypeMod(..) 
-    , makeVmod_2_0
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( makeRuleset 
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceXSD
-    , namespaceXsdType
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , addVarBinding
-    , VarBindingModify(..)
-    )
-
-{- in Prelude???-import Maybe
-    ( Maybe (..), maybeToList )
-
-import Monad
-    ( liftM )
--}-
-------------------------------------------------------------
---  Misc values
-------------------------------------------------------------
-
---  Local name for Integer datatype
-nameXsdString      = "string"
-
--- |Type name for xsd:integer datatype
-typeNameXsdString  = ScopedName namespaceXSD nameXsdString
-
--- |Namespace for xsd:integer datatype functions
-namespaceXsdString = namespaceXsdType nameXsdString
-
---  Helper to catenate strings with newline separator,
---  used for making textual representations of graphs.
---  (the newline makes N3 parser diagnostics easier to interpret)
---
-infixr 5 +++
-(+++) :: String -> ShowS
-(+++) str = ((str++"\n")++)
-
---  Compose with function of two arguments
-c2 = (.) . (.)
-
-------------------------------------------------------------
---  Declare exported RDFDatatype value for xsd:integer
-------------------------------------------------------------
-
-rdfDatatypeXsdString :: RDFDatatype
-rdfDatatypeXsdString = Datatype rdfDatatypeValXsdString
-
-------------------------------------------------------------
---  Implmentation of RDFDatatypeVal for xsd:integer
-------------------------------------------------------------
-
--- |Define Datatype value for xsd:string
---
-rdfDatatypeValXsdString :: RDFDatatypeVal String
-rdfDatatypeValXsdString = DatatypeVal
-    { tvalName      = typeNameXsdString
-    , tvalRules     = rdfRulesetXsdString  -- Ruleset RDFGraph
-    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString
-                                           -- RDFGraph -> [RDFRules]
-    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString
-    , tvalMap       = mapXsdString         -- DatatypeMap Integer
-    , tvalRel       = relXsdString         -- [DatatypeRel Integer]
-    , tvalMod       = modXsdString         -- [DatatypeMod Integer]
-    }
-
--- |mapXsdString contains functions that perform lexical-to-value
---  and value-to-canonical-lexical mappings for xsd:string values
---
---  These are identity mappings.
---
-mapXsdString :: DatatypeMap String
-mapXsdString = DatatypeMap
-    { -- mapL2V :: String -> Maybe String
-      mapL2V = Just
-      -- mapV2L :: String -> Maybe String
-    , mapV2L = Just
-    }
-
--- |relXsdString contains useful relations for xsd:string values.
---
-relXsdString :: [DatatypeRel String]
-relXsdString =
-    [ relXsdStringEq
-    , relXsdStringNe
-    ]
-
-mkStrRel2 ::
-    String -> DatatypeRelPr String -> UnaryFnTable String
-    -> DatatypeRel String
-mkStrRel2 nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdString nam
-    , dtRelFunc = altArgs pr fns unaryFnApp
-    }
-
-mkStrRel3 ::
-    String -> DatatypeRelPr String -> BinaryFnTable String
-    -> DatatypeRel String
-mkStrRel3 nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdString nam
-    , dtRelFunc = altArgs pr fns binaryFnApp
-    }
-
-mkStrRel3maybe ::
-    String -> DatatypeRelPr String -> BinMaybeFnTable String
-    -> DatatypeRel String
-mkStrRel3maybe nam pr fns = DatatypeRel
-    { dtRelName = ScopedName namespaceXsdString nam
-    , dtRelFunc = altArgs pr fns binMaybeFnApp
-    }
-
-liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool
-liftL2 p i1 i2 as = p (i1 as) (i2 as)
-
-lcomp :: (a->a->Bool) -> [a] -> Bool
-lcomp p = liftL2 p head (head . tail)
-
--- eq
-
-relXsdStringEq :: DatatypeRel String
-relXsdStringEq = mkStrRel2 "eq" (lcomp (==))
-    ( repeat (const True, []) )
-
--- ne
-
-relXsdStringNe :: DatatypeRel String
-relXsdStringNe = mkStrRel2 "ne" (lcomp (/=))
-    ( repeat (const True, []) )
-
--- |modXsdString contains variable binding modifiers for xsd:string values.
---
-modXsdString :: [RDFDatatypeMod String]
-modXsdString =
-    [ modXsdStringEq
-    , modXsdStringNe
-    ]
-
-modXsdStringEq = modXsdStringCompare "eq" (==)
-modXsdStringNe = modXsdStringCompare "ne" (/=)
-
-modXsdStringCompare ::
-    String -> (String->String->Bool) -> RDFDatatypeMod String
-modXsdStringCompare nam rel = DatatypeMod
-    { dmName = (ScopedName namespaceXsdString nam)
-    , dmModf = [ f0 ]
-    , dmAppf = makeVmod_2_0
-    }
-    where
-        f0 vs@[v1,v2] = if rel v1 v2 then vs else []
-        f0 _          = []
-
--- |rulesetXsdString contains rules and axioms that allow additional
---  deductions when xsd:string values appear in a graph.
---
---  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
---
-rdfRulesetXsdString =
-    makeRuleset namespaceXsdString axiomsXsdString rulesXsdString
-
-mkPrefix ns =
-    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"
-
-prefixXsdString =
-    mkPrefix namespaceRDF  ++
-    mkPrefix namespaceRDFS ++
-    mkPrefix namespaceRDFD ++
-    mkPrefix namespaceXSD  ++
-    mkPrefix namespaceXsdString ++
-    " \n"
-
-mkAxiom :: String -> String -> RDFFormula
-mkAxiom local gr =
-    makeRDFFormula namespaceXsdString local (prefixXsdString++gr)
-
-axiomsXsdString =
-    [ mkAxiom "dt"      "xsd:string rdf:type rdfs:Datatype ."
-    ]
-
-rulesXsdString = rulesXsdStringClosure ++ rulesXsdStringRestriction
-
-rulesXsdStringRestriction =
-    makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString gr
-    where
-        gr = makeRDFGraphFromN3String rulesXsdStringStr
-
-rulesXsdStringStr = prefixXsdString
-    +++ "xsd_string:Eq a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_string:eq ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-    +++ "xsd_string:Ne a rdfd:GeneralRestriction ; "
-    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
-    +++ "  rdfd:constraint xsd_string:ne ; "
-    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
-
-rulesXsdStringClosure =
-    [ xsdstrls
-    , xsdstrsl
-    ]
-
---  Infer string from plain literal
-xsdstrls = makeN3ClosureRule namespaceXsdString "ls"
-            "?a ?p ?l ."
-            "?a ?p ?s ."
-            (stringPlain "?s" "?l")
-
---  Infer plain literal from string
-xsdstrsl = makeN3ClosureRule namespaceXsdString "sl"
-            "?a ?p ?s ."
-            "?a ?p ?l ."
-            (stringPlain "?s" "?l")
-
---  Map between string and plain literal values
-stringPlain :: String -> String -> RDFVarBindingModify
-stringPlain svar lvar =
-    stringPlainValue (vn svar) (vn lvar)
-    where
-            vn ('?':n) = Var n
-
---  Variable binding modifier to create new binding to a canonical
---  form of a datatyped literal.
-stringPlainValue ::
-    RDFLabel -> RDFLabel -> RDFVarBindingModify
-stringPlainValue svar lvar = VarBindingModify
-        { vbmName   = ScopedName namespaceRDFD "stringPlain"
-        , vbmApply  = concatMap app1
-        , vbmVocab  = [svar,lvar]
-        , vbmUsage  = [[svar],[lvar],[]]
-        }
-    where
-        app1 vbind = app2 (vbMap vbind svar) (vbMap vbind lvar) vbind
-        app2 (Just (Lit s (Just typeNameXsdString)))
-             (Just (Lit l (Nothing)))
-             vbind
-             | s == l
-             = [vbind]
-        app2 (Just (Lit s (Just typeNameXsdString)))
-             (Nothing)
-             vbind
-             = [addVarBinding lvar (Lit s (Nothing)) vbind]
-        app2 (Nothing)
-             (Just (Lit l (Nothing)))
-             vbind
-             = [addVarBinding svar (Lit l (Just typeNameXsdString)) vbind]
-        app2 _ _ _ = []
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdString.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: RDFDatatypeXsdString.hs,v $
--- Revision 1.2  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.1  2003/12/18 20:46:24  graham
--- Added xsd:string module to capture equivalence of xsd:string
--- and plain literals without a language tag
---
− Swish/HaskellRDF/RDFGraph.hs 
@@ -1,864 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}-{-# OPTIONS -XMultiParamTypeClasses #-}-{-# OPTIONS -XTypeSynonymInstances #-}----------------------------------------------------------------------------------
---  $Id: RDFGraph.hs,v 1.48 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFGraph
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a memory-based RDF graph instance.
---
---------------------------------------------------------------------------------
-
-------------------------------------------------------------
--- Simple labelled directed graph value
-------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
-    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
-    , getLiteralText, getScopedName, makeBlank
-    , RDFTriple
-    , NSGraph(..), RDFGraph
-    , NamespaceMap, RevNamespaceMap
-    , emptyNamespaceMap
-    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
-    , addArc, merge
-    , allLabels, allNodes, remapLabels, remapLabelList
-    , newNode, newNodes
-    , setNamespaces, getNamespaces
-    , setFormulae, getFormulae, setFormula, getFormula
-    , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}
-      -- Re-export from GraphClass
-    , LDGraph(..), Label (..), Arc(..)
-    , arc, arcSubj, arcPred, arcObj, Selector
-      -- Export selected RDFLabel values
-    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
-    , res_rdfs_member
-    , res_rdfd_GeneralRestriction
-    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
-    , res_owl_sameAs
-    , res_operator_plus, res_operator_minus
-    , res_operator_slash, res_operator_star
-      -- Exported for testing:
-    , grMatchMap, grEq
-    , mapnode, maplist
-    )
-where
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , makeNamespaceQName
-    , getQName, getScopedNameURI
-    , ScopedName(..)
-    , makeScopedName, makeQNameScopedName
-    , nullScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFC
-    , namespaceRDFO
-    , namespaceXSD
-    , namespaceXsdType
-    , namespaceOWL
-    , namespaceMATH
-    , namespaceLOG
-    , namespaceDAML
-    , namespaceLang, langTag, isLang
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
-    , rdfs_member
-    , rdfd_GeneralRestriction
-    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
-    , owl_sameAs
-    , operator_plus, operator_minus, operator_slash, operator_star
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-
-import Swish.HaskellRDF.GraphClass
-    ( LDGraph(..), Label (..)
-    , Arc(..), arc, arcSubj, arcPred, arcObj
-    , Selector )
-
-import Swish.HaskellRDF.GraphMatch
-    ( graphMatch, LabelMap(..), ScopedLabel(..) )
-
-import Swish.HaskellUtils.MiscHelpers
-    ( hash, lower, quote )
-
-import Swish.HaskellUtils.ListHelpers
-    ( addSetElem )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..), LookupEntryClass(..)
-    , mapFind, mapFindMaybe, mapReplaceOrAdd, mapEq, mapVals, mapKeys
-    , mapTranslateKeys, mapTranslateVals
-    , mapTranslateEntries, mapTranslateEntriesM )
-
-import Swish.HaskellUtils.FunctorM
-    ( FunctorM(..) )
-
-import Data.Char
-    ( isDigit )
-
-import Data.Maybe
-    ( isJust )
-
-import Data.List
-    ( nub, intersect, union, findIndices )
-
------------------------------------------------------------
---  RDF graph node values
-------------------------------------------------------------
---
---  cf. http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax
---
---  This is extended from the RDF abstract graph syntax in the
---  following ways:
---  (a) a graph can be part of a resource node or blank node
---      (cf. Notation3 formulae)
---  (b) a "variable" node option is distinguished from a
---      blank node.
---      I have found this useful for encoding and handling
---      queries, even though query variables can be expressed
---      as blank nodes.
---  (c) a "NoNode" option is defined.
---      This might otherwise be handled by Maybe (RDFLabel g)
-
-data RDFLabel =
-      Res ScopedName                    -- resource
-    | Lit String (Maybe ScopedName)     -- literal [type/language]
-    | Blank String                      -- blank node
-    | Var String                        -- variable (not used in ordinary graphs)
-    | NoNode                            -- no node  (not used in ordinary graphs)
-
-instance Eq RDFLabel where
-    (==) = labelEq
-
-instance Show RDFLabel where
-    show (Res sn)           = show sn
-    show (Lit st Nothing)   = quote st
-    show (Lit st (Just nam))
-        | isLang nam = quote st ++ "@"  ++ (langTag nam)
-        | otherwise  = quote st ++ "^^" ++ (show nam)
-    show (Blank ln)         = "_:"++ln
-    show (Var ln)           = "?"++ln
-    show NoNode             = "<NoNode>"
-
-instance Ord RDFLabel where
-    -- Optimize some common cases..
-    compare (Res sn1)      (Res sn2)      = compare sn1 sn2
-    compare (Blank ln1)    (Blank ln2)    = compare ln1 ln2
-    compare (Res _)        (Blank _)      = LT
-    compare (Blank _)      (Res _)        = GT
-    -- .. else use show string comparison
-    compare l1 l2 = compare (show l1) (show l2)
-    -- Similarly for <=
-    (Res qn1)   <= (Res qn2)      = qn1 <= qn2
-    (Blank ln1) <= (Blank ln2)    = ln1 <= ln2
-    (Res _)     <= (Blank _)      = True
-    (Blank _)   <= (Res _)        = False
-    l1 <= l2                      = (show l1) <= (show l2)
-
-instance Label RDFLabel where
-    labelIsVar (Blank _)    = True
-    labelIsVar (Var _)      = True
-    labelIsVar _            = False
-    getLocal   (Blank loc)  = loc
-    getLocal   (Var   loc)  = '?':loc
-    getLocal   (Res   sn)   = "Res_"++snLocal sn
-    getLocal   (NoNode)     = "None"
-    getLocal   _            = "Lit_"
-    makeLabel  ('?':loc)    = Var loc
-    makeLabel  loc          = Blank loc
-    labelHash seed lb       = hash seed (showCanon lb)
-
---  Get canonical string for RDF label.
---  Used for hashing, so that equivalent labels always return
---  the same hash value.
-showCanon :: RDFLabel -> String
-showCanon (Res sn)           = "<"++getScopedNameURI sn++">"
-showCanon (Lit st (Just nam))
-        | isLang nam = quote st ++ "@"  ++ (langTag nam)
-        | otherwise  = quote st ++ "^^" ++ (getScopedNameURI nam)
-showCanon lb                 = show lb
-
-
--- Define equality of nodes possibly based on different graph types.
---
--- The version of equality defined here is not strictly RDF abstract syntax
--- equality, but my interpretation of equivalence for the purposes of
--- entailment, in the absence of any specific datatype knowledge other
--- than XML literals.
---
-labelEq :: RDFLabel -> RDFLabel -> Bool
-labelEq (Res q1)            (Res q2)        = (q1 == q2)
-labelEq (Blank s1)          (Blank s2)      = (s1 == s2)
-labelEq (Var v1)            (Var v2)        = (v1 == v2)
-labelEq (Lit s1 t1)         (Lit s2 t2)     = (s1 == s2) && (t1 == t2)
-labelEq _                   _               = False
-
----------------------------------------------------------
---  Selected RDFLabel values
----------------------------------------------------------
-
-res_rdf_type                = Res rdf_type
-res_rdf_first               = Res rdf_first
-res_rdf_rest                = Res rdf_rest
-res_rdf_nil                 = Res rdf_nil
-res_rdfs_member             = Res rdfs_member
-res_rdfd_GeneralRestriction = Res rdfd_GeneralRestriction
-res_rdfd_onProperties       = Res rdfd_onProperties
-res_rdfd_constraint         = Res rdfd_constraint
-res_rdfd_maxCardinality     = Res rdfd_maxCardinality
-res_owl_sameAs              = Res owl_sameAs
-res_operator_plus           = Res operator_plus
-res_operator_minus          = Res operator_minus
-res_operator_slash          = Res operator_slash
-res_operator_star           = Res operator_star
-
----------------------------------------------------------
---  Additional functions on RDFLabel values
----------------------------------------------------------
-
--- |Test if supplied labal is a URI resource node
-isUri :: RDFLabel -> Bool
-isUri (Res _) = True
-isUri  _      = False
-
--- |Test if supplied labal is a literal node
-isLiteral :: RDFLabel -> Bool
-isLiteral (Lit _ _) = True
-isLiteral  _        = False
-
--- |Test if supplied labal is an untyped literal node
-isUntypedLiteral :: RDFLabel -> Bool
-isUntypedLiteral (Lit _ Nothing  ) = True
-isUntypedLiteral (Lit _ (Just tn)) = isLang tn
-isUntypedLiteral  _                = False
-
--- |Test if supplied labal is an untyped literal node
-isTypedLiteral :: RDFLabel -> Bool
-isTypedLiteral (Lit _ (Just tn)) = not (isLang tn)
-isTypedLiteral  _                = False
-
--- |Test if supplied labal is an XML literal node
-isXMLLiteral :: RDFLabel -> Bool
-isXMLLiteral = isDatatyped rdf_XMLLiteral
-
--- |Test if supplied label is an typed literal node of a given datatype
-isDatatyped :: ScopedName -> RDFLabel -> Bool
-isDatatyped d  (Lit _ (Just n)) = (n == d)
-isDatatyped _  _                = False
-
--- |Test if supplied label is a container membership property
---
---  Check for namespace is RDF namespace and
---  first character of local name is '_' and
---  remaining characters of local name are all digits
-isMemberProp :: RDFLabel -> Bool
-isMemberProp (Res sn) = ( snScope sn == namespaceRDF  ) &&
-                        ( head loc   == '_'   ) &&
-                        ( and . map isDigit . tail $ loc )
-                        where
-                            loc = snLocal sn
-isMemberProp _        = False
-
--- |Test if supplied labal is a blank node
-isBlank :: RDFLabel -> Bool
-isBlank (Blank _) = True
-isBlank  _        = False
-
--- |Test if supplied labal is a query variable
-isQueryVar :: RDFLabel -> Bool
-isQueryVar (Var _) = True
-isQueryVar  _      = False
-
--- |Extract text value from a literal node
-getLiteralText :: RDFLabel -> String
-getLiteralText (Lit s _) = s
-getLiteralText  _        = ""
-
--- |Extract ScopedName value from a resource node
-getScopedName :: RDFLabel -> ScopedName
-getScopedName (Res sn) = sn
-getScopedName  _       = nullScopedName
-
--- |Make a blank node from a supplied query variable,
---  or return the supplied label unchanged.
---  (Use this in when substituting an existential for an
---  unsubstituted query variable.)
-makeBlank :: RDFLabel -> RDFLabel
-makeBlank  (Var loc)    = Blank loc
-makeBlank  lb           = lb
-
----------------------------------------------------------
---  RDF Triple (statement)
----------------------------------------------------------
-
-type RDFTriple = Arc RDFLabel
-
----------------------------------------------------------
---  Namespace prefix list entry
----------------------------------------------------------
-
-type NamespaceMap = LookupMap Namespace
-
-data RevNamespace = RevNamespace Namespace
-
-instance LookupEntryClass RevNamespace String String where
-    keyVal   (RevNamespace (Namespace pre uri)) = (uri,pre)
-    newEntry (uri,pre) = (RevNamespace (Namespace pre uri))
-
-type RevNamespaceMap = LookupMap RevNamespace
-
-emptyNamespaceMap = LookupMap [] :: NamespaceMap
-
----------------------------------------------------------
---  Graph formula entry
----------------------------------------------------------
-
-data LookupFormula lb gr = Formula
-    { formLabel :: lb
-    , formGraph :: gr
-    }
-
-instance ( Eq lb, Eq gr ) => Eq (LookupFormula lb gr) where
-    f1 == f2 = ( formLabel f1 == formLabel f2 ) &&
-               ( formGraph f1 == formGraph f2 )
-
-instance (Label lb)
-    => LookupEntryClass (LookupFormula lb (NSGraph lb)) lb (NSGraph lb)
-    where
-        keyVal fe      = (formLabel fe, formGraph fe)
-        newEntry (k,v) = Formula { formLabel=k, formGraph=v }
-
-instance (Label lb) => Show (LookupFormula lb (NSGraph lb))
-    where
-        show (Formula l g) = (show l) ++ " :- { " ++ (showArcs "    " g) ++ " }"
-
-type Formula lb = LookupFormula lb (NSGraph lb)
-
-type FormulaMap lb = LookupMap (LookupFormula lb (NSGraph lb))
-
-emptyFormulaMap = LookupMap [] :: FormulaMap RDFLabel
-
-{-  given up on trying to do Functor for formulae...
-instance Functor (LookupFormula (NSGraph lb)) where
-    fmap f fm = mapTranslateEntries (mapFormulaEntry f) fm
--}
-
-formulaeMap :: (lb -> l2) -> FormulaMap lb -> FormulaMap l2
-formulaeMap f fm = mapTranslateEntries (formulaEntryMap f) fm
-
-formulaEntryMap ::
-    (lb -> l2)
-    -> LookupFormula lb (NSGraph lb)
-    -> LookupFormula l2 (NSGraph l2)
-formulaEntryMap f (Formula k gr) = Formula (f k) (fmap f gr)
-
---  What follows is a monadic variant of formulaeMap, used to
---  apply a transformation and collect some result in a single
---  pass.
-
-formulaeMapM ::
-    (Monad m) => (lb -> m l2) -> FormulaMap lb -> m (FormulaMap l2)
-formulaeMapM f fm = mapTranslateEntriesM (formulaEntryMapM f) fm
-
-formulaEntryMapM ::
-    (Monad m)
-    => (lb -> m l2)
-    -> LookupFormula lb (NSGraph lb)
-    -> m (LookupFormula l2 (NSGraph l2))
-formulaEntryMapM f (Formula k gr) =
-    do  { f2 <- f k
-        ; g2 <- (fmapM f gr)
-        ; return $ Formula f2 g2
-        }
-
----------------------------------------------------------
---  Memory-based graph with namespaces and subgraphs
----------------------------------------------------------
-
-data NSGraph lb = NSGraph
-    { namespaces :: NamespaceMap
-    , formulae   :: FormulaMap lb
-    , statements :: [Arc lb]
-    }
-
-getNamespaces   :: NSGraph lb -> NamespaceMap
-getNamespaces g = namespaces g
-
-setNamespaces      :: NamespaceMap -> NSGraph lb -> NSGraph lb
-setNamespaces ns g = g { namespaces=ns }
-
-getFormulae   :: NSGraph lb -> FormulaMap lb
-getFormulae g = formulae g
-
-setFormulae      :: FormulaMap lb -> NSGraph lb -> NSGraph lb
-setFormulae fs g = g { formulae=fs }
-
-getFormula     :: (Label lb) => NSGraph lb -> lb -> Maybe (NSGraph lb)
-getFormula g l = mapFindMaybe l (formulae g)
-
-setFormula     :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb
-setFormula f g = g { formulae=(mapReplaceOrAdd f (formulae g)) }
-
-instance (Label lb) => LDGraph NSGraph lb where
-    getArcs g    = statements g
-    setArcs as g = g { statements=as }
-
--- Optimized method to add arc .. don't check for duplicates.
-addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb
-addArc ar gr = gr { statements=(addSetElem ar (statements gr)) }
-
-instance Functor NSGraph where
-    fmap f g = g { statements = (map $ fmap f) (statements g)
-                 , formulae   = formulaeMap f (formulae g)
-                 }
-
-instance FunctorM NSGraph where
-    fmapM f g =
-        do  { s2 <- (mapM $ fmapM f) (statements g)
-            ; f2 <- formulaeMapM f (formulae g)
-            ; return $ g { statements = s2, formulae = f2 }
-            }
-
-instance (Label lb) => Eq (NSGraph lb) where
-    (==) = grEq
-
-instance (Label lb) => Show (NSGraph lb) where
-    show      gr = grShow "" gr
-    showList grs = grShowList "" grs
-
-grShowList _ []     = showString "[no graphs]"
-grShowList p (g:gs) = showChar '[' . showString (grShow pp g) . showl gs
-    where
-        showl []     = showChar ']' -- showString $ "\n" ++ p ++ "]"
-        showl (g:gs) = showString (",\n "++p++grShow pp g) . showl gs
-        pp           = ' ':p
-
-grShow   :: (Label lb) => String -> NSGraph lb -> String
-grShow p g =
-    "Graph, formulae: " ++ (showForm p g) ++ "\n" ++
-    p ++ "arcs: " ++ (showArcs p g)
-    where
-        showForm p g = (foldr (++) "" (map ( (pp++) . show ) formulae ))
-        (LookupMap formulae) = getFormulae g
-        pp = "\n    " ++ p
-
-showArcs :: (Label lb) => String -> NSGraph lb -> String
-showArcs p g = (foldr (++) "" (map ( (pp++) . show ) (getArcs g) ))
-    where
-        pp = "\n    " ++ p
-
-grEq :: (Label lb) => NSGraph lb -> NSGraph lb -> Bool
-grEq g1 g2 = fst ( grMatchMap g1 g2 )
-
-grMatchMap :: (Label lb) =>
-    NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))
-grMatchMap g1 g2 =
-    graphMatch matchable (getArcs g1) (getArcs g2)
-    where
-        matchable l1 l2 = (mapFormula g1 l1) == (mapFormula g2 l2)
-        mapFormula g l  = mapFindMaybe l (getFormulae g)
-
-toNSGraph :: (Eq lb, Show lb) => [Arc lb] -> NSGraph lb
-toNSGraph arcs =
-    NSGraph
-        { statements = arcs
-        , namespaces = emptyNamespaceMap
-        , formulae   = LookupMap []
-        }
-
----------------------------------------------------------
---  Merge RDF graphs, renaming bnodes in the second graph
---  as necessary
----------------------------------------------------------
-
--- |Merge RDF graphs, renaming blank and query variable nodes as
---  needed to neep variable nodes from the two graphs distinct in
---  the resulting graph.
-merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb
-merge gr1 gr2 =
-    let
-        bn1   = allLabels labelIsVar gr1
-        bn2   = allLabels labelIsVar gr2
-        dupbn = intersect bn1 bn2
-        allbn = union bn1 bn2
-    in
-        add gr1 (remapLabels dupbn allbn id gr2)
-
--- |Return list of all labels (including properties) in the graph
---  satisfying a supplied filter predicate.
-allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
-allLabels p gr = filter p (unionNodes p (formulaNodes p gr) (labels gr) )
-
--- |Return list of all subjects and objects in the graph
---  satisfying a supplied filter predicate.
-allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
-allNodes p gr = unionNodes p [] (nodes gr)
-
---  List all nodes in graph formulae satisfying a supplied predicate
-formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
-formulaNodes p gr = foldl (unionNodes p) fkeys (map (allLabels p) fvals)
-    where
-        -- fm :: (Label lb) => FormulaMap lb
-        --                     LookupMap LookupFormula (NSGraph lb) lb
-        fm    = formulae gr
-        -- fvals :: (Label lb) => [NSGraph lb]
-        fvals = mapVals fm
-        -- fkeys :: (Label lb) => [lb]
-        fkeys = filter p $ mapKeys fm
-
---  Helper to filter variable nodes and merge with those found so far
-unionNodes :: (Label lb) => (lb -> Bool) -> [lb] -> [lb] -> [lb]
-unionNodes p ls1 ls2 = ls1 `union` (filter p ls2)
-
----------------------------------------------------------
---  Remap selected nodes in a graph
----------------------------------------------------------
-
--- |Remap selected nodes in graph:
---
---  dupbn is list of variable nodes to be renamed
---  allbn is list of variable nodes used that must be avoided
---  cnvbn is a node conversion function that is applied to nodes
---        from 'dupbn' in the graph that are to be replaced by
---        new blank nodes.  If no such conversion is required,
---        supply 'id'.  Function 'makeBlank' can be used to convert
---        RDF query nodes into RDF blank nodes.
---  gr    is graph in which nodes are to be renamed
---
---  This is the node renaming operation that prevents graph-scoped
---  variable nodes from being merged when two graphs are merged.
-remapLabels ::
-    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> NSGraph lb -> NSGraph lb
-remapLabels dupbn allbn cnvbn gr = fmap (mapnode dupbn allbn cnvbn) gr
-
--- |Externally callable function to construct a list of (old,new)
---  values to be used for graph label remapping.  The supplied arguments
---  are (a) a list of labels to be remaped, and (b) a list of labels
---  to be avoided by the remapping:  the latter should be a list of
---  all the variable nodes in the graph to which the remapping will be
---  applied.
-remapLabelList ::
-    (Label lb) => [lb] -> [lb] -> [(lb,lb)]
-remapLabelList remap avoid = maplist remap avoid id []
-
---  Remap a single graph node.
---  If the node is not one of those to be remapped,
---  the supplied value is returned unchanged.
-mapnode ::
-    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> lb -> lb
-mapnode dupbn allbn cnvbn nv =
-    mapFind nv nv (LookupMap (maplist dupbn allbn cnvbn []))
-
---  Construct a list of (oldnode,newnode) values to be used for
---  graph label remapping.  The function operates recursiovely, adding
---  new nodes generated to the mapping list (mapbn') and also to the
---  list of nodes to be avoided (allbn').
-maplist ::
-    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> [(lb,lb)] -> [(lb,lb)]
-maplist []         _     _     mapbn = mapbn
-maplist (dn:dupbn) allbn cnvbn mapbn = maplist dupbn allbn' cnvbn mapbn'
-    where
-        dnmap  = newNode (cnvbn dn) allbn
-        mapbn' = (dn,dnmap):mapbn
-        allbn' = dnmap:allbn
-
--- |Given a node and a list of existing nodes, find a new node for
---  the supplied node that does not clash with any existing node.
---  (Generates an non-terminating list of possible replacements, and
---  picks the first one that isn't already in use.)
---
---  [[[TODO: optimize this for common case nnn and _nnn:
---    always generate _nnn and keep track of last allocated]]]
-newNode :: (Label lb) => lb -> [lb] -> lb
-newNode dn existnodes =
-    head $ newNodes dn existnodes
-
--- |Given a node and a list of existing nodes, generate a list of new
---  nodes for the supplied node that do not clash with any existing node.
-newNodes :: (Label lb) => lb -> [lb] -> [lb]
-newNodes dn existnodes =
-    filter (not . (flip elem existnodes)) $ trynodes (noderootindex dn)
-
-noderootindex :: (Label lb) => lb -> (String,Int)
-noderootindex dn = (nh,nx) where
-    (nh,nt) = splitnodeid $ getLocal dn
-    nx      = if null nt then 0 else read nt
-
-splitnodeid :: String -> (String,String)
-splitnodeid dn = splitAt (tx+1) dn where
-    tx = last $ (-1):findIndices (not . isDigit) dn
-
-trynodes :: (Label lb) => (String,Int) -> [lb]
-trynodes (nr,nx) = [ makeLabel (nr++(show n)) | n <- iterate (+1) nx ]
-
-trybnodes :: (Label lb) => (String,Int) -> [lb]
-trybnodes (nr,nx) = [ makeLabel (nr++(show n)) | n <- iterate (+1) nx ]
-
----------------------------------------------------------
---  Memory-based RDF graph type and graph class functions
----------------------------------------------------------
-
-type RDFGraph = NSGraph RDFLabel
-
--- |Create a new RDF graph from a supplied list of arcs
-toRDFGraph :: [Arc RDFLabel] -> RDFGraph
-toRDFGraph arcs = toNSGraph arcs
-
--- |Create a new, empty RDF graph.
-emptyRDFGraph :: RDFGraph
-emptyRDFGraph = toRDFGraph []
-
-{-
--- |Update an RDF graph using a supplied list of arcs, keeping
---  prefix definitions and formula definitions from the original.
---
---  [[[TODO:  I think this may be redundant - the default graph
---  class has an update method which accepts a function to update
---  the arcs, not touching other parts of the graph value.]]]
-updateRDFGraph :: RDFGraph -> [Arc RDFLabel] -> RDFGraph
-updateRDFGraph gr as = gr { statements=as }
--}
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFGraph.hs,v $
--- $Author: graham $
--- $Revision: 1.48 $
--- $Log: RDFGraph.hs,v $
--- Revision 1.48  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.47  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.46  2004/01/06 16:29:56  graham
--- Fix up module exports to avoid GHC warnings
---
--- Revision 1.45  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.44  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.43  2003/11/24 15:46:03  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.42  2003/11/14 21:48:35  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.41  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.40  2003/10/24 21:02:42  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.39  2003/10/22 15:47:46  graham
--- Working on datatype inference support.
---
--- Revision 1.38  2003/10/01 00:36:25  graham
--- Added RDFGraph method to test for container membership property label.
--- Added RDFQuery filter function to select container membership properties.
---
--- Revision 1.37  2003/09/30 16:39:41  graham
--- Refactor proof code to use new ruleset logic.
--- Moved some support code from RDFProofCheck to RDFRuleset.
---
--- Revision 1.36  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.35  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.34  2003/07/03 20:31:07  graham
--- Add initial draft of datatype framework.
---
--- Revision 1.33  2003/07/02 21:27:30  graham
--- Graph closure with instance rule tested.
--- About to change ProofTest for graph forward chaining to return
--- a single result graph.
---
--- Revision 1.32  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.31  2003/06/27 21:02:59  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.30  2003/06/25 21:16:52  graham
--- Reworked N3 formatting logic to support proof display.
--- Basic proof display is working.
---
--- Revision 1.29  2003/06/19 19:49:07  graham
--- RDFProofCheck compiles, but test fails
---
--- Revision 1.28  2003/06/17 15:43:35  graham
--- remapNodes now accepts a node-mapping function rather than just
--- a Boolean to control conversion of query variable nodes to blank
--- nodes, and who knows what else.
---
--- Revision 1.27  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.26  2003/06/12 00:49:05  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
--- Revision 1.25  2003/06/10 17:38:34  graham
--- Remove some unneeded calss constraints from data type declarations
--- Reworked NSGraph to be an instance of Functor, replacing function
--- gmap with fmap.  Graph formulae are still not handled well:  the data types
--- will need re-working so that a "Formula lb" type constructor can be
--- introduced having the correct (* -> *) kind to be a Functor.
---
--- Revision 1.24  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.23  2003/05/30 15:04:56  graham
--- Fix references to defunct GraphHelpers module
---
--- Revision 1.22  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.21  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.20  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.19  2003/05/27 19:15:50  graham
--- Graph merge (with blank node renaming) complete and passes tests.
---
--- Revision 1.18  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.17  2003/05/23 19:33:36  graham
--- Added and tested RDF graph label translation functions
---
--- Revision 1.16  2003/05/23 00:02:42  graham
--- Fixed blank node id generation bug in N3Formatter
---
--- Revision 1.15  2003/05/14 22:39:23  graham
--- Initial formatter tests all run OK.
--- The formatter could still use so,me improvement,
--- but it
--- passes the minimal round-tripping tests.
---
--- Revision 1.14  2003/05/14 16:50:32  graham
--- Graph matching seems solid now:
--- RDFGraphTest and N3ParserTest pass all tests
--- Updated TODO file with comments from code
---
--- Revision 1.13  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.12  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.11  2003/05/07 19:25:00  graham
--- Restructured formula handling in RDF graph
---
--- Revision 1.10  2003/05/01 00:21:41  graham
--- Started refactoring LookupMap.
--- Revised module compiles OK.
--- Working on test module.
---
--- Revision 1.9  2003/04/29 22:07:10  graham
--- Some refactoring of N3 formatter.
--- N3 formatter now handles trivial cases.
--- More complex formatter test cases still to be developed.
---
--- Revision 1.8  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.7  2003/04/15 21:40:54  graham
--- N3Parser compiles
--- Some small changes to RDFGraph
--- Added some QName methods
---
--- Revision 1.6  2003/04/11 17:38:34  graham
--- Rename GraphLookupMap to LookupMap
---
--- Revision 1.5  2003/04/10 20:08:39  graham
--- Reorganized RDFGraph naming (RDFGraphTest OK)
--- Progressing N3Parser
---
--- Revision 1.4  2003/04/10 15:06:30  graham
--- RDFGraph now passes all test cases
---
--- Revision 1.3  2003/04/10 13:36:45  graham
--- Renamed GraphRDF to RDFGraph
---
--- Revision 1.1  2003/04/10 08:36:06  graham
--- Graph matching passes battery of new tests
--- Started work on RDF graph
---
− Swish/HaskellRDF/RDFGraphShowM.hs 
@@ -1,81 +0,0 @@-{-# OPTIONS -XTypeSynonymInstances #-}
-
---------------------------------------------------------------------------------
---  $Id: RDFGraphShowM.hs,v 1.2 2003/09/24 18:50:52 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFGraphShowM
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + ????
---
---  This module defines a ShowM class instance for RDFGraph, to be
---  used when displaying RDF Graph values as part of a proof sequence,
---  etc.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFGraphShowM()
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , isUri, isLiteral, isXMLLiteral, isBlank, isQueryVar, makeBlank
-    , RDFTriple
-    , NSGraph(..), RDFGraph )
-
-import Swish.HaskellRDF.N3Formatter
-    ( formatGraphIndent )
-
-import Swish.HaskellUtils.ShowM
-    ( ShowM(..), showm )
-
-
-------------------------------------------------------------
---  ShowM instance for RDFGraph
-------------------------------------------------------------
-
-instance ShowM RDFGraph where
-    showms linebreak graph = formatGraphIndent linebreak False graph
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFGraphShowM.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: RDFGraphShowM.hs,v $
--- Revision 1.2  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.1  2003/06/25 21:20:12  graham
--- Add ShowM class and RDF graph instance to CVS.
--- This is part of reworking N3 formatting logic to support proof display,
--- and other multiline display requirements.
---
− Swish/HaskellRDF/RDFGraphTest.hs 
@@ -1,1575 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFGraphTest.hs,v 1.32 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFGraphTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for module RDFGraph.
---
---------------------------------------------------------------------------------
-
---  WNH RIP OUT module Swish.HaskellRDF.RDFGraphTest where
-
-import Swish.HaskellUtils.FunctorM
-    ( FunctorM(..) )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..)
-    , mapFind, mapFindMaybe, mapContains )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Swish.HaskellRDF.GraphClass
-    ( Label(..), Arc, arcSubj, arcPred, arcObj, arc )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , makeQNameScopedName
-    , nullScopedName
-    , makeUriScopedName
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
-    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
-    , isDatatyped, isMemberProp
-    , isUri, isBlank, isQueryVar, makeBlank
-    , getScopedName
-    -- , LookupNamespace(..), Namespace
-    , NamespaceMap, emptyNamespaceMap
-    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
-    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
-    , allLabels, remapLabels, remapLabelList
-    , setNamespaces, getNamespaces
-    , setFormulae, getFormulae, setFormula, getFormula
-    , emptyRDFGraph, toRDFGraph
-    , newNode, newNodes
-    , grMatchMap, grEq )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-{-
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFC
-    , namespaceRDFO
-    , namespaceXSD
-    , namespaceXsdType
-    , namespaceOWL
-    , namespaceMATH
-    , namespaceLOG
-    , namespaceDAML
--}
-    , namespaceLang, langName, langTag, isLang
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
-    , rdfs_member
-    , rdfd_GeneralRestriction
-    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
-    , owl_sameAs
-    , operator_plus, operator_minus, operator_slash, operator_star
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-import Data.List
-    ( elemIndex )
-
-import Data.Maybe
-    ( fromJust )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle )
-
-------------------------------------------------------------
---  Common definitions
-------------------------------------------------------------
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-------------------------------------------------------------
---  Test language tag comparisons
-------------------------------------------------------------
-
-type Lang = Maybe ScopedName
-
-lt0 = Nothing
-lt1 = Just (langName "en")
-lt2 = Just (langName "EN")
-lt3 = Just (langName "fr")
-lt4 = Just (langName "FR")
-lt5 = Just (langName "en-us")
-lt6 = Just (langName "en-US")
-lt7 = Just (langName "EN-us")
-lt8 = Just (langName "EN-US")
-
-langlist =
-  [ ("lt0",lt0),
-    ("lt1",lt1), ("lt2",lt2), ("lt3",lt3), ("lt4",lt4),
-    ("lt5",lt5), ("lt6",lt6), ("lt7",lt7), ("lt8",lt8) ]
-
-langeqlist =
-  [
-    ("lt1","lt2"),
-    ("lt3","lt4"),
-    ("lt5","lt6"),
-    ("lt5","lt7"),
-    ("lt5","lt8"),
-    ("lt6","lt7"),
-    ("lt6","lt8"),
-    ("lt7","lt8")
-  ]
-
-testLangEq :: String -> Bool -> Lang -> Lang -> Test
-testLangEq lab eq l1 l2 =
-    TestCase ( assertEqual ("testLangEq:"++lab) eq (l1==l2) )
-
-testLangEqSuite = TestList
-  [ testLangEq (testLab l1 l2) (testEq  l1 l2) t1 t2
-      | (l1,t1) <- langlist , (l2,t2) <- langlist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` langeqlist ||
-            (l2,l1) `elem` langeqlist
-
-------------------------------------------------------------
---  Define some common values
-------------------------------------------------------------
-
-base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-
-qb1s1 = ScopedName base1 "s1"
-qb2s2 = ScopedName base2 "s2"
-qb3s3 = ScopedName base3 "s3"
-qb3   = ScopedName base3 ""
-qb3bm = ScopedName base3 "basemore"
-qb4m  = ScopedName base4 "more"
-
-s1 = Res qb1s1  :: RDFLabel
-s2 = Res qb2s2  :: RDFLabel
-s3 = Res qb3s3  :: RDFLabel
-s4 = Res qb3    :: RDFLabel
-s5 = Blank "s5" :: RDFLabel
-s6 = Res qb3bm  :: RDFLabel
-s7 = Res qb4m   :: RDFLabel
-s8 = Blank "s8" :: RDFLabel
-
-qb1st1 = ScopedName base1 "st1"
-qb2st2 = ScopedName base2 "st2"
-qb3st3 = ScopedName base3 "st3"
-
-st1 = Res qb1st1  :: RDFLabel
-st2 = Res qb2st2  :: RDFLabel
-st3 = Res qb3st3  :: RDFLabel
-
-bb  = Blank "bb"  :: RDFLabel
-bb0 = Blank "bb0" :: RDFLabel
-b1  = Blank "b1"  :: RDFLabel
-b2  = Blank "b2"  :: RDFLabel
-b3  = Blank "b3"  :: RDFLabel
-b4  = Blank "b4"  :: RDFLabel
-b5  = Blank "b5"  :: RDFLabel
-b6  = Blank "b6"  :: RDFLabel
-b7  = Blank "b7"  :: RDFLabel
-b8  = Blank "b8"  :: RDFLabel
-b9  = Blank "b9"  :: RDFLabel
-b10 = Blank "b10" :: RDFLabel
-
-c1 = Blank "c1" :: RDFLabel
-c2 = Blank "c2" :: RDFLabel
-c3 = Blank "c3" :: RDFLabel
-c4 = Blank "c4" :: RDFLabel
-
-ba1 = Blank "_1" :: RDFLabel
-ba2 = Blank "_2" :: RDFLabel
-ba3 = Blank "_3" :: RDFLabel
-ba4 = Blank "_4" :: RDFLabel
-
-bn3 = Blank "3" :: RDFLabel
-bn4 = Blank "4" :: RDFLabel
-bn5 = Blank "5" :: RDFLabel
-bn6 = Blank "6" :: RDFLabel
-
-qb1p1 = ScopedName base1 "p1"
-qb2p2 = ScopedName base2 "p2"
-qb3p3 = ScopedName base3 "p3"
-qb4p4 = ScopedName base3 "p4"
-qb1o1 = ScopedName base1 "o1"
-qb2o2 = ScopedName base2 "o2"
-qb3o3 = ScopedName base3 "o3"
-
-p1 = Res qb1p1  :: RDFLabel
-p2 = Res qb2p2  :: RDFLabel
-p3 = Res qb3p3  :: RDFLabel
-p4 = Res qb4p4  :: RDFLabel
-
-o1 = Res qb1o1  :: RDFLabel
-o2 = Res qb2o2  :: RDFLabel
-o3 = Res qb3o3  :: RDFLabel
-o4 = Res qb3    :: RDFLabel
-o5 = Blank "o5" :: RDFLabel
-o6 = Blank "s5" :: RDFLabel
-
-qb1t1 = ScopedName base1 "type1"
-qb1t2 = ScopedName base1 "type2"
-
-l1  = Lit "l1"  Nothing                 :: RDFLabel
-l2  = Lit "l2"  (Just (langName "en"))  :: RDFLabel
-l3  = Lit "l2"  (Just (langName "fr"))  :: RDFLabel
-l4  = Lit "l4"  (Just qb1t1)            :: RDFLabel
-l5  = Lit "l4"  (Just qb1t1)            :: RDFLabel -- (Lang "en")
-l6  = Lit "l4"  (Just qb1t1)            :: RDFLabel -- (Lang "fr")
-l7  = Lit "l4"  (Just qb1t2)            :: RDFLabel
-l8  = Lit "l4"  (Just qb1t2)            :: RDFLabel -- (Lang "en")
-l9  = Lit "l4"  (Just qb1t2)            :: RDFLabel -- (Lang "fr")
-l10 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel
-l11 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel -- (Lang "en")
-l12 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel -- (Lang "fr")
-
-v1  = Var "v1"   :: RDFLabel
-v2  = Var "v2"   :: RDFLabel
-v3  = Var "v3"   :: RDFLabel
-v4  = Var "v4"   :: RDFLabel
-vb3 = Blank "v3" :: RDFLabel
-vb4 = Blank "v4" :: RDFLabel
-
--- Test cases for isMemberProp
-qcm1 = ScopedName namespaceRDF "_1"
-qcm2 = ScopedName namespaceRDF "_234567"
-qnm1 = ScopedName namespaceRDF "987"
-qnm2 = ScopedName namespaceRDF "_987a65"
-
-cm1  = Res qcm1  :: RDFLabel
-cm2  = Res qcm2  :: RDFLabel
-nm1  = Res qnm1  :: RDFLabel
-nm2  = Res qnm2  :: RDFLabel
-
-------------------------------------------------------------
---  RDFLabel construction and equality tests
-------------------------------------------------------------
-
-testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
-testLabelEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
-
-nodelist =
-  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5)
-  , ("s6",s6), ("s7",s7), ("s8",s8)
-  , ("b1",b1), ("b2",b2), ("b3",b3), ("b4",b4)
-  , ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4)
-  , ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4), ("o5",o5)
-  , ("l1",l1), ("l2",l2), ("l3",l3)
-  , ("l4",l4), ("l5",l5), ("l6",l6)
-  , ("l7",l7), ("l8",l8), ("l9",l9)
-  , ("l10",l10), ("l11",l11), ("l12",l12)
-  , ("v1",v1), ("v2",v2)
-  ]
-
-nodeeqlist =
-  [ ("s4","o4")
-  , ("s5","o6")
-  , ("s6","s7")
-  , ("l4","l5")
-  , ("l4","l6")
-  , ("l5","l6")
-  , ("l7","l8")
-  , ("l7","l9")
-  , ("l8","l9")
-  , ("l10","l11")
-  , ("l10","l12")
-  , ("l11","l12")
-  ]
-
-testNodeEqSuite = TestList
-  [ testLabelEq (testLab l1 l2) (testEq  l1 l2) n1 n2
-      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` nodeeqlist ||
-            (l2,l1) `elem` nodeeqlist
-
-------------------------------------------------------------
---  RDFLabel classification tests
-------------------------------------------------------------
-
-testClass :: String -> (RDFLabel -> Bool) -> RDFLabel -> Bool -> Test
-testClass lab clsf nod eq =
-    TestCase ( assertEqual ("testClass:"++lab) eq (clsf nod) )
-
-testClass01 = testClass "testClass01" isUri            s1  True
-testClass02 = testClass "testClass02" isUri            s5  False
-testClass03 = testClass "testClass03" isUri            ba1 False
-testClass04 = testClass "testClass04" isUri            l1  False
-testClass05 = testClass "testClass05" isUri            l10 False
-testClass06 = testClass "testClass06" isUri            cm1 True
-testClass07 = testClass "testClass07" isUri            nm1 True
-testClass08 = testClass "testClass08" isUri            v1  False
-
-testClass10 = testClass "testClass10" isLiteral        s1  False
-testClass11 = testClass "testClass11" isLiteral        s5  False
-testClass12 = testClass "testClass12" isLiteral        ba1 False
-testClass13 = testClass "testClass13" isLiteral        l1  True
-testClass14 = testClass "testClass14" isLiteral        l4  True
-testClass15 = testClass "testClass15" isLiteral        l5  True
-testClass16 = testClass "testClass16" isLiteral        l10 True
-testClass17 = testClass "testClass17" isLiteral        l11 True
-testClass18 = testClass "testClass18" isLiteral        cm1 False
-testClass19 = testClass "testClass19" isLiteral        v1  False
-
-testClass20 = testClass "testClass20" isTypedLiteral   s1  False
-testClass21 = testClass "testClass21" isTypedLiteral   s5  False
-testClass22 = testClass "testClass22" isTypedLiteral   ba1 False
-testClass23 = testClass "testClass23" isTypedLiteral   l1  False
-testClass24 = testClass "testClass24" isTypedLiteral   l2  False
-testClass25 = testClass "testClass25" isTypedLiteral   l4  True
-testClass26 = testClass "testClass26" isTypedLiteral   l5  True
-testClass27 = testClass "testClass27" isTypedLiteral   l10 True
-testClass28 = testClass "testClass28" isTypedLiteral   l11 True
-testClass29 = testClass "testClass29" isTypedLiteral   v1  False
-
-testClass30 = testClass "testClass30" isUntypedLiteral s1  False
-testClass31 = testClass "testClass31" isUntypedLiteral s5  False
-testClass32 = testClass "testClass32" isUntypedLiteral ba1 False
-testClass33 = testClass "testClass33" isUntypedLiteral l1  True
-testClass34 = testClass "testClass34" isUntypedLiteral l2  True
-testClass35 = testClass "testClass35" isUntypedLiteral l4  False
-testClass36 = testClass "testClass36" isUntypedLiteral l5  False
-testClass37 = testClass "testClass37" isUntypedLiteral l10 False
-testClass38 = testClass "testClass38" isUntypedLiteral l11 False
-testClass39 = testClass "testClass39" isUntypedLiteral v1  False
-
-testClass40 = testClass "testClass40" isXMLLiteral     s1  False
-testClass41 = testClass "testClass41" isXMLLiteral     s5  False
-testClass42 = testClass "testClass42" isXMLLiteral     ba1 False
-testClass43 = testClass "testClass43" isXMLLiteral     l1  False
-testClass44 = testClass "testClass44" isXMLLiteral     l2  False
-testClass45 = testClass "testClass45" isXMLLiteral     l4  False
-testClass46 = testClass "testClass46" isXMLLiteral     l5  False
-testClass47 = testClass "testClass47" isXMLLiteral     l10 True
-testClass48 = testClass "testClass48" isXMLLiteral     l11 True
-testClass49 = testClass "testClass49" isXMLLiteral     v1  False
-
-altIsXmlLit = isDatatyped rdf_XMLLiteral
-testClass50 = testClass "testClass50" altIsXmlLit      s1  False
-testClass51 = testClass "testClass51" altIsXmlLit      s5  False
-testClass52 = testClass "testClass52" altIsXmlLit      ba1 False
-testClass53 = testClass "testClass53" altIsXmlLit      l1  False
-testClass54 = testClass "testClass54" altIsXmlLit      l2  False
-testClass55 = testClass "testClass55" altIsXmlLit      l4  False
-testClass56 = testClass "testClass56" altIsXmlLit      l5  False
-testClass57 = testClass "testClass57" altIsXmlLit      l10 True
-testClass58 = testClass "testClass58" altIsXmlLit      l11 True
-
-testClass60 = testClass "testClass60" isMemberProp     s1  False
-testClass61 = testClass "testClass61" isMemberProp     s5  False
-testClass62 = testClass "testClass62" isMemberProp     ba1 False
-testClass63 = testClass "testClass63" isMemberProp     l1  False
-testClass64 = testClass "testClass64" isMemberProp     l10 False
-testClass65 = testClass "testClass65" isMemberProp     cm1 True
-testClass66 = testClass "testClass66" isMemberProp     cm2 True
-testClass67 = testClass "testClass67" isMemberProp     nm1 False
-testClass68 = testClass "testClass68" isMemberProp     nm2 False
-
-testClass70 = testClass "testClass70" isBlank          s7  False
-testClass71 = testClass "testClass71" isBlank          s5  True
-testClass72 = testClass "testClass72" isBlank          ba1 True
-testClass73 = testClass "testClass73" isBlank          l1  False
-testClass74 = testClass "testClass74" isBlank          l4  False
-testClass75 = testClass "testClass75" isBlank          l5  False
-testClass76 = testClass "testClass76" isBlank          l10 False
-testClass77 = testClass "testClass77" isBlank          l11 False
-testClass78 = testClass "testClass78" isBlank          cm1 False
-testClass79 = testClass "testClass79" isBlank          v1  False
-
-testClass80 = testClass "testClass80" isQueryVar       s8  False
-testClass81 = testClass "testClass81" isQueryVar       s5  False
-testClass82 = testClass "testClass82" isQueryVar       ba1 False
-testClass83 = testClass "testClass83" isQueryVar       l1  False
-testClass84 = testClass "testClass84" isQueryVar       l4  False
-testClass85 = testClass "testClass85" isQueryVar       l5  False
-testClass86 = testClass "testClass86" isQueryVar       l10 False
-testClass87 = testClass "testClass87" isQueryVar       l11 False
-testClass88 = testClass "testClass88" isQueryVar       cm1 False
-testClass89 = testClass "testClass89" isQueryVar       v1  True
-
-testNodeClassSuite = TestList
-  [              testClass01, testClass02, testClass03, testClass04
-  , testClass05, testClass06, testClass07, testClass08
-  , testClass10, testClass11, testClass12, testClass13, testClass14
-  , testClass15, testClass16, testClass17, testClass18, testClass19
-  , testClass20, testClass21, testClass22, testClass23, testClass24
-  , testClass25, testClass26, testClass27, testClass28, testClass29
-  , testClass30, testClass31, testClass32, testClass33, testClass34
-  , testClass35, testClass36, testClass37, testClass38, testClass39
-  , testClass40, testClass41, testClass42, testClass43, testClass44
-  , testClass45, testClass46, testClass47, testClass48, testClass49
-  , testClass50, testClass51, testClass52, testClass53, testClass54
-  , testClass55, testClass56, testClass57, testClass58
-  , testClass60, testClass61, testClass62, testClass63, testClass64
-  , testClass65, testClass66, testClass67, testClass68
-  , testClass70, testClass71, testClass72, testClass73, testClass74
-  , testClass75, testClass76, testClass77, testClass78, testClass79
-  , testClass80, testClass81, testClass82, testClass83, testClass84
-  , testClass85, testClass86, testClass87, testClass88, testClass89
-  ]
-
-------------------------------------------------------------
---  RDFLabel local part separation and recombination tests
-------------------------------------------------------------
-
-testLocalEq :: String -> String -> String -> Test
-testLocalEq lab l1 l2 =
-    TestCase ( assertEqual ("testLocalEq:"++lab) l1 l2 )
-
-testLocalLabEq :: String -> RDFLabel -> RDFLabel -> Test
-testLocalLabEq lab l1 l2 =
-    TestCase ( assertEqual ("testLocalEq:"++lab) l1 l2 )
-
-testNodeLocal01 = testLocalEq    "01" "b1"  (getLocal b1)
-testNodeLocal02 = testLocalEq    "02" "b2"  (getLocal b2)
-testNodeLocal03 = testLocalEq    "03" "?v1" (getLocal v1)
-testNodeLocal04 = testLocalEq    "04" "?v2" (getLocal v2)
-testNodeLocal05 = testLocalLabEq "05" b1    (makeLabel "b1")
-testNodeLocal06 = testLocalLabEq "06" b2    (makeLabel "b2")
-testNodeLocal07 = testLocalLabEq "07" v1    (makeLabel "?v1")
-testNodeLocal08 = testLocalLabEq "08" v2    (makeLabel "?v2")
-
-testNodeLocalSuite = TestList
-  [ testNodeLocal01
-  , testNodeLocal02
-  , testNodeLocal03
-  , testNodeLocal04
-  , testNodeLocal05
-  , testNodeLocal06
-  , testNodeLocal07
-  , testNodeLocal08
-  ]
-
-------------------------------------------------------------
---  Node generation tests
-------------------------------------------------------------
-
-testNodeEq :: String -> RDFLabel -> RDFLabel -> Test
-testNodeEq lab l1 l2 =
-    TestCase ( assertEqual ("testNodeEq:"++lab) l1 l2 )
-
-tnn01 = (newNode  v1 [b1,b3,v1,v2])
-tnn02 = (newNode  b1 [b1,b3,v1,v2])
-tnn03 = (newNodes b1 [b1,b3,v1,v2])!!0
-tnn04 = (newNodes b1 [b1,b3,v1,v2])!!1
-tnn05 = (newNodes b1 [b1,b3,v1,v2])!!2
-tnn06 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!0
-tnn07 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!1
-tnn08 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!2
-tnn09 = (newNodes l1 [b1,b3,v1,v2,tnns3])!!2
-
-tnns1 = Blank "Res_s1"
-tnns2 = Blank "Res_s2"
-tnns3 = Blank "Res_s3"
-tnns4 = Blank "Res_s4"
-tnnl1 = Blank "Lit_2"
-
-testNewNode01 = testNodeEq "testNewNode01" v3    tnn01
-testNewNode02 = testNodeEq "testNewNode02" b2    tnn02
-testNewNode03 = testNodeEq "testNewNode03" b2    tnn03
-testNewNode04 = testNodeEq "testNewNode04" b4    tnn04
-testNewNode05 = testNodeEq "testNewNode05" b5    tnn05
-testNewNode06 = testNodeEq "testNewNode06" tnns1 tnn06
-testNewNode07 = testNodeEq "testNewNode07" tnns2 tnn07
-testNewNode08 = testNodeEq "testNewNode08" tnns4 tnn08
-testNewNode09 = testNodeEq "testNewNode09" tnnl1 tnn09
-
-testNewNodeSuite = TestList
-  [ testNewNode01
-  , testNewNode02
-  , testNewNode03
-  , testNewNode04
-  , testNewNode05
-  , testNewNode06
-  , testNewNode07
-  , testNewNode08
-  , testNewNode09
-  ]
-
-------------------------------------------------------------
---  RDFLabel ordering tests
-------------------------------------------------------------
-
-testLabelOrd :: String -> Ordering -> RDFLabel -> RDFLabel -> Test
-testLabelOrd lab order n1 n2 =
-    TestCase ( assertEqual
-               ("testLabelOrd:"++lab++"["++(show n1)++","++(show n2)++"]")
-               order (compare n1 n2) )
-
-nodeorder =
-  -- literals
-  [ "l1"
-  , "l11", "l12", "l10"
-  , "l2", "l3"
-  , "l5", "l6", "l4", "l8", "l9", "l7"
-  -- variables
-  , "v1", "v2"
-  -- URIs
-  , "o1", "p1", "s1"
-  , "o2", "p2", "s2"
-  , "s4", "o4", "s6", "s7"
-  , "o3", "p3", "p4", "s3"
-  -- blank nodes
-  , "b1", "b2", "b3", "b4"
-  , "o5", "s5", "s8"
-  ]
-
-testNodeOrdSuite = TestList
-  [ testLabelOrd (testLab l1 l2) (testOrd l1 l2) n1 n2
-      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testOrd l1 l2
-      | testEq l1 l2  = EQ
-      | otherwise     = compare (fromJust $ elemIndex l1 nodeorder)
-                                (fromJust $ elemIndex l2 nodeorder)
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` nodeeqlist ||
-            (l2,l1) `elem` nodeeqlist
-
-------------------------------------------------------------
---  Other RDFLabel tests
-------------------------------------------------------------
-
-testLabelName01 = testEq "testLabelName01" (getScopedName s1) qb1s1
-testLabelName02 = testEq "testLabelName02" (getScopedName b1) nullScopedName
-testLabelName03 = testEq "testLabelName03" (getScopedName l1) nullScopedName
-testLabelName04 = testEq "testLabelName04" (getScopedName v1) nullScopedName
-
-testLabelOtherSuite = TestList
-    [ testLabelName01, testLabelName02, testLabelName03, testLabelName04
-    ]
-
-------------------------------------------------------------
---  Statement construction and equality tests
-------------------------------------------------------------
-
-testStmtEq :: String -> Bool -> RDFTriple -> RDFTriple -> Test
-testStmtEq lab eq t1 t2 =
-    TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )
-
-slist =
-  [
-    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)
-  ]
-
-plist =
-  [
-    ("p1",p1)
-  ]
-
-olist =
-  [ ("o1",o1), ("o4",o4), ("o5",o5),
-    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)
-  ]
-
-tlist =
-  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]
-    where
-    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o
-    trp (_,s) (_,p) (_,o) = arc s p o
-
-stmteqlist =
-  [
-    ("s6.p1.l1", "s7.p1.l1"),
-    ("s6.p1.l4", "s7.p1.l4"),
-    ("s6.p1.l7", "s7.p1.l7"),
-    ("s6.p1.l7", "s7.p1.l8"),
-    ("s6.p1.l8", "s7.p1.l7"),
-    ("s6.p1.l8", "s7.p1.l8"),
-    ("s6.p1.l10","s7.p1.l10"),
-    ("s6.p1.o1", "s7.p1.o1"),
-    ("s6.p1.o4", "s7.p1.o4"),
-    ("s6.p1.o5", "s7.p1.o5"),
-    ("s1.p1.l7", "s1.p1.l8"),
-    ("s4.p1.l7", "s4.p1.l8"),
-    ("s5.p1.l7", "s5.p1.l8"),
-    ("s6.p1.l7", "s6.p1.l8"),
-    ("s7.p1.l7", "s7.p1.l8")
-  ]
-
-testStmtEqSuite = TestList
-  [ testStmtEq (testLab l1 l2) (testEq  l1 l2) t1 t2
-      | (l1,t1) <- tlist , (l2,t2) <- tlist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` stmteqlist ||
-            (l2,l1) `elem` stmteqlist
-
-------------------------------------------------------------
---  Graph construction and equality tests
-------------------------------------------------------------
-
-testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
-testGraphEq lab eq g1 g2 =
-    --  Set test False to get extra trace info about graph differences
-    --  Some tests will fail with this setting, so revert to True to
-    --  get test result.
-    if True then
-        TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-    else
-        TestList
-            [ TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-            , TestCase ( assertEqual ("testGraphEq:"++lab) g1 g2 )
-            ]
-
-testGraphEqM :: String -> Bool -> Maybe RDFGraph -> Maybe RDFGraph -> Test
-testGraphEqM lab eq g1 g2 =
-    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
-
-t01 = arc s1 p1 o1
-t02 = arc s2 p1 o2
-t03 = arc s3 p1 o3
-t04 = arc s1 p1 l1
-t05 = arc s2 p1 l4
-t06 = arc s3 p1 l10
-
-t10 = arc s1 p1 b1
-t11 = arc b1 p2 b2
-t12 = arc b2 p3 o1
-
-t20 = arc s1 p1 b3
-t21 = arc b3 p2 b4
-t22 = arc b4 p3 o1
-
-tt01 = arc st1 p1 o1
-tt02 = arc st2 p1 o2
-tt03 = arc st3 p1 o3
-tt04 = arc st1 p1 l1
-tt05 = arc st2 p1 l4
-tt06 = arc st3 p1 l10
-
-makeNewPrefixNamespace :: (String,Namespace) -> Namespace
-makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)
-
-nslist = LookupMap $ map makeNewPrefixNamespace
-    [ ("base1",base1)
-    , ("base2",base2)
-    , ("base3",base3)
-    , ("base4",base4)
-    ]
-
-nslistalt = LookupMap $ map makeNewPrefixNamespace
-    [ ("altbase1",base1)
-    , ("altbase2",base2)
-    , ("altbase3",base3)
-    ]
-
-g1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01]
-        }
-
-gt1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tt01]
-        }
-
--- Check for nonsensitivety of graph equility to namespace differences:
-g1alt = NSGraph
-        { namespaces = nslistalt
-        , formulae   = emptyFormulaMap
-        , statements = [t01]
-        }
-
---  Construct version of g1 using just URIs
-uris1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
-urip1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#p1"
-urio1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#o1"
-tu01  = arc (Res uris1) (Res urip1) (Res urio1)
-g1uri = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tu01]
-        }
-
-g2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05,t06]
-        }
-
-gt2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tt01,tt02,tt03,tt04,tt05,tt06]
-        }
-
-g3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t06,t05,t04,t03,t02,t01]
-        }
-
-gt3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tt06,tt05,tt04,tt03,tt02,tt01]
-        }
-
-g4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05,t06,t10,t11,t12]
-        }
-
-g5 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05,t06,t20,t21,t22]
-        }
-
-g6 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
-        }
-
-g7 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t01,t02]
-        }
-
-g8 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t02,t01]
-        }
-
-g9 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t03,t02,t01]
-        }
-
-g9a = addArc t03 g8
-
-g10 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [t02,t02,t01]
-        }
-
-g10a = addArc t02 g8
-
-glist =
-  [ ("g1",g1), ("g1alt",g1alt), ("g1uri",g1uri)
-  , ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6)
-  , ("g7",g7), ("g8",g8), ("g9",g9), ("g10",g10)
-  , ("g9a",g9a), ("g10a",g10a)
-  ]
-
-grapheqlist =
-  [ ("g1","g1alt")
-  , ("g1","g1uri")
-  , ("g1alt","g1uri")
-  , ("g2","g3")
-  , ("g4","g5")
-  , ("g7","g8")
-  , ("g7","g10")
-  , ("g7","g10a")
-  , ("g8","g10")
-  , ("g8","g10a")
-  , ("g9","g9a")
-  , ("g10","g10a")
-  ]
-
-testGraphEqSuite = TestList
-  [ testGraphEq (testLab l1 l2) (testEq l1 l2) g1 g2
-      | (l1,g1) <- glist , (l2,g2) <- glist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` grapheqlist ||
-            (l2,l1) `elem` grapheqlist
-
--- Selected tests for debugging
-geq12 = testGraphEq "g1-g2" False g1 g2
-geq21 = testGraphEq "g2-g1" False g2 g1
-geq22 = testGraphEq "g2-g2" True  g2 g2
-geq23 = testGraphEq "g2-g3" True  g2 g3
-geq14 = testGraphEq "g1-g4" False g1 g4
-geq24 = testGraphEq "g2-g4" False g2 g4
-geq77 = testGraphEq "g7-g7" True  g7 g7
-geq78 = testGraphEq "g7-g8" True  g7 g8
-geq87 = testGraphEq "g8-g7" True  g8 g7
-geq99a   = testGraphEq "g9-g9a"   True g9 g9a
-geq1010a = testGraphEq "g10-g10a" True g10 g10a
-
-testGraphEqSelSuite = TestList
-  [ geq12
-  , geq21
-  , geq22
-  , geq23
-  , geq14
-  , geq24
-  , geq77
-  , geq78
-  , geq87
-  , geq99a
-  , geq1010a
-  ]
-
-
-------------------------------------------------------------
---  Test updating formulae
-------------------------------------------------------------
-
-testFormulaLookup ::
-    String -> FormulaMap RDFLabel -> RDFLabel -> Maybe RDFGraph -> Test
-testFormulaLookup lab fs fl gr =
-    TestCase ( assertEqual ("testFormulaLookup:"++lab) gr jfg )
-    where
-        jfg  = mapFindMaybe fl fs
-
-testMaybeEq :: (Eq a, Show a) => String -> Maybe a -> Maybe a -> Test
-testMaybeEq lab m1 m2 =
-    TestCase ( assertEqual ("testMaybeEq:"++lab) m1 m2 )
-
-g1f1 = g1
-f1   = getFormulae g1f1
-testGraphFormula01a = testFormulaLookup "01a" f1 s1 Nothing
-testGraphFormula01b = testFormulaLookup "01b" f1 s2 Nothing
-testGraphFormula01c = testFormulaLookup "01c" f1 s3 Nothing
-
-fm2  = LookupMap [Formula s2 g2]
-g1f2 = setFormulae fm2 g1f1
-f2   = getFormulae g1f2
-testGraphFormula02a = testFormulaLookup "02a" f2 s1 Nothing
-testGraphFormula02b = testFormulaLookup "02b" f2 s2 (Just g2)
-testGraphFormula02c = testFormulaLookup "02c" f2 s3 Nothing
-
-fm3  = LookupMap [Formula s1 g1,Formula s2 g2,Formula s3 g3]
-g1f3 = setFormulae fm3 g1f1
-f3   = getFormulae g1f3
-testGraphFormula03a = testFormulaLookup "03a" f3 s1 (Just g1)
-testGraphFormula03b = testFormulaLookup "03b" f3 s2 (Just g2)
-testGraphFormula03c = testFormulaLookup "03c" f3 s3 (Just g3)
-
-fm4  = LookupMap [Formula s1 g1,Formula s2 g3,Formula s3 g3]
-g1f4 = setFormulae fm4 g1f1
-f4   = getFormulae g1f4
-testGraphFormula04a = testFormulaLookup "04a" f4 s1 (Just g1)
-testGraphFormula04b = testFormulaLookup "04b" f4 s2 (Just g3)
-testGraphFormula04c = testFormulaLookup "04c" f4 s3 (Just g3)
-
-fm5  = LookupMap [Formula s1 g1,Formula s2 g4,Formula s3 g6]
-g1f5 = setFormulae fm5 g1f1
-f5   = getFormulae g1f5
-testGraphFormula05a = testFormulaLookup "05a" f5 s1 (Just g1)
-testGraphFormula05b = testFormulaLookup "05b" f5 s2 (Just g4)
-testGraphFormula05c = testFormulaLookup "05c" f5 s3 (Just g6)
-
-fm6  = LookupMap [Formula s1 g1,Formula s2 g5,Formula s3 g6]
-g1f6 = setFormulae fm6 g1f1
-f6   = getFormulae g1f6
-testGraphFormula06a = testFormulaLookup "06a" f6 s1 (Just g1)
-testGraphFormula06b = testFormulaLookup "06b" f6 s2 (Just g5)
-testGraphFormula06c = testFormulaLookup "06c" f6 s3 (Just g6)
-
-fm7  = LookupMap [Formula s1 g1,Formula s2 g7,Formula s3 g6]
-g1f7 = setFormulae fm7 g1f1
-f7   = getFormulae g1f7
-testGraphFormula07a = testFormulaLookup "07a" f7 s1 (Just g1)
-testGraphFormula07b = testFormulaLookup "07b" f7 s2 (Just g7)
-testGraphFormula07c = testFormulaLookup "07c" f7 s3 (Just g6)
-
---  Same pattern as 1-3, but using base graph with more nodes used:
---  The graph comparison results are expected to be different,
---  because of formulae associated with nodes actually used in the
---  graph
-g2f1 = g2
-f8   = getFormulae g2f1
-testGraphFormula08a = testFormulaLookup "08a" f8 s1 Nothing
-testGraphFormula08b = testFormulaLookup "08b" f8 s2 Nothing
-testGraphFormula08c = testFormulaLookup "08c" f8 s3 Nothing
-
-g2f2 = setFormulae fm2 g2f1
-f9   = getFormulae g2f2
-testGraphFormula09a = testFormulaLookup "09a" f9 s1 Nothing
-testGraphFormula09b = testFormulaLookup "09b" f9 s2 (Just g2)
-testGraphFormula09c = testFormulaLookup "09c" f9 s3 Nothing
-
-g2f3 = setFormulae fm3 g2f1
-f10   = getFormulae g2f3
-testGraphFormula10a = testFormulaLookup "10a" f10 s1 (Just g1)
-testGraphFormula10b = testFormulaLookup "10b" f10 s2 (Just g2)
-testGraphFormula10c = testFormulaLookup "10c" f10 s3 (Just g3)
-
---  Comparison of graphs containing formulae.
---  The intent is that graphs are matched if there is a bijection,
---  where the matched nodes are associated with matching formulae.
---  Definitions of formulae not used in the graphs don't affect the
---  match result.
-testGraphFormula11a = testGraphEq "g1f1-g1f1" True  g1f1 g1f1
-testGraphFormula11b = testGraphEq "g1f1-g1f2" True  g1f1 g1f2
-testGraphFormula11c = testGraphEq "g1f1-g1f3" False g1f1 g1f3
-
-testGraphFormula12a = testGraphEq "g1f2-g1f1" True  g1f2 g1f1
-testGraphFormula12b = testGraphEq "g1f2-g1f2" True  g1f2 g1f2
-testGraphFormula12c = testGraphEq "g1f2-g1f3" False g1f2 g1f3
-
-testGraphFormula13a = testGraphEq "g1f3-g1f1" False g1f3 g1f1
-testGraphFormula13b = testGraphEq "g1f3-g1f2" False g1f3 g1f2
-testGraphFormula13c = testGraphEq "g1f3-g1f3" True  g1f3 g1f3
-
-testGraphFormula14a = testGraphEq "g1f4-g1f3" True  g1f4 g1f3
-testGraphFormula14b = testGraphEq "g1f4-g1f4" True  g1f4 g1f4
-testGraphFormula14c = testGraphEq "g1f4-g1f5" True  g1f4 g1f5
-
-testGraphFormula15a = testGraphEq "g1f5-g1f5" True  g1f5 g1f5
-testGraphFormula15b = testGraphEq "g1f5-g1f6" True  g1f5 g1f6
-testGraphFormula15c = testGraphEq "g1f5-g1f7" True  g1f5 g1f7
-
-testGraphFormula16a = testGraphEq "g1f6-g1f5" True  g1f6 g1f5
-testGraphFormula16b = testGraphEq "g1f6-g1f6" True  g1f6 g1f6
-testGraphFormula16c = testGraphEq "g1f6-g1f7" True  g1f6 g1f7
-
-testGraphFormula17a = testGraphEq "g1f7-g1f5" True  g1f7 g1f5
-testGraphFormula17b = testGraphEq "g1f7-g1f6" True  g1f7 g1f6
-testGraphFormula17c = testGraphEq "g1f7-g1f7" True  g1f7 g1f7
-
-testGraphFormula18a = testGraphEq "g2f1-g2f1" True  g2f1 g2f1
-testGraphFormula18b = testGraphEq "g2f1-g2f2" False g2f1 g2f2
-testGraphFormula18c = testGraphEq "g2f1-g2f3" False g2f1 g2f3
-
-testGraphFormula19a = testGraphEq "g2f2-g2f1" False g2f2 g2f1
-testGraphFormula19b = testGraphEq "g2f2-g2f2" True  g2f2 g2f2
-testGraphFormula19c = testGraphEq "g2f2-g2f3" False g2f2 g2f3
-
-testGraphFormula20a = testGraphEq "g2f3-g2f1" False g2f3 g2f1
-testGraphFormula20b = testGraphEq "g2f3-g2f2" False g2f3 g2f2
-testGraphFormula20c = testGraphEq "g2f3-g2f3" True  g2f3 g2f3
-
---  Test methods to set/access an individual formula in a graph
-g1f21 = setFormula  (Formula s1 g7) g1f2
-f21   = getFormulae g1f21
-testGraphFormula21a = testFormulaLookup "21a" f21 s1 (Just g7)
-testGraphFormula21b = testFormulaLookup "21b" f21 s2 (Just g2)
-testGraphFormula21c = testFormulaLookup "21c" f21 s3 Nothing
-
-g1f22 = setFormula  (Formula s1 g1) g1f21
-f22   = getFormulae g1f22
-testGraphFormula22a = testFormulaLookup "22a" f22 s1 (Just g1)
-testGraphFormula22b = testFormulaLookup "22b" f22 s2 (Just g2)
-testGraphFormula22c = testFormulaLookup "22c" f22 s3 Nothing
-
-f23a = getFormula g1f22 s1
-f23b = getFormula g1f22 s2
-f23c = getFormula g1f22 s3
-testGraphFormula23a = testMaybeEq "23a" f23a (Just g1)
-testGraphFormula23b = testMaybeEq "23b" f23b (Just g2)
-testGraphFormula23c = testMaybeEq "23c" f23c Nothing
-
-
-testGraphFormulaSuite = TestLabel "TestFormulae" $ TestList
-  [ testGraphFormula01a, testGraphFormula01b, testGraphFormula01c
-  , testGraphFormula02a, testGraphFormula02b, testGraphFormula02c
-  , testGraphFormula03a, testGraphFormula03b, testGraphFormula03c
-  , testGraphFormula04a, testGraphFormula04b, testGraphFormula04c
-  , testGraphFormula05a, testGraphFormula05b, testGraphFormula05c
-  , testGraphFormula06a, testGraphFormula06b, testGraphFormula06c
-  , testGraphFormula07a, testGraphFormula07b, testGraphFormula07c
-  , testGraphFormula08a, testGraphFormula08b, testGraphFormula08c
-  , testGraphFormula09a, testGraphFormula09b, testGraphFormula09c
-  , testGraphFormula10a, testGraphFormula10b, testGraphFormula10c
-  , testGraphFormula11a, testGraphFormula11b, testGraphFormula11c
-  , testGraphFormula12a, testGraphFormula12b, testGraphFormula12c
-  , testGraphFormula13a, testGraphFormula13b, testGraphFormula13c
-  , testGraphFormula14a, testGraphFormula14b, testGraphFormula14c
-  , testGraphFormula15a, testGraphFormula15b, testGraphFormula15c
-  , testGraphFormula16a, testGraphFormula16b, testGraphFormula16c
-  , testGraphFormula17a, testGraphFormula17b, testGraphFormula17c
-  , testGraphFormula18a, testGraphFormula18b, testGraphFormula18c
-  , testGraphFormula19a, testGraphFormula19b, testGraphFormula19c
-  , testGraphFormula20a, testGraphFormula20b, testGraphFormula20c
-  , testGraphFormula21a, testGraphFormula21b, testGraphFormula21c
-  , testGraphFormula22a, testGraphFormula22b, testGraphFormula22c
-  , testGraphFormula23a, testGraphFormula23b, testGraphFormula23c
-  ]
-
-------------------------------------------------------------
---  Test fmap translations of graphs, including formulae
-------------------------------------------------------------
-
-translate lab
-    | lab == s1 = st1
-    | lab == s2 = st2
-    | lab == s3 = st3
-    | otherwise = lab
-
-translateM lab
-    | lab == s1   = Just st1
-    | lab == s2   = Just st2
-    | lab == s3   = Just st3
-    | isBlank lab = Nothing
-    | otherwise   = Just lab
-
-gt1f1a = gt1
-gt1f1b = fmap translate g1f1
-ft1    = getFormulae gt1f1b
-testGraphTranslate01a = testGraphEq "gt1f1a-gt1f1b" True gt1f1a gt1f1b
-testGraphTranslate01b = testFormulaLookup "GraphTranslate01b" ft1 st1 Nothing
-testGraphTranslate01c = testFormulaLookup "GraphTranslate01c" ft1 st2 Nothing
-testGraphTranslate01d = testFormulaLookup "GraphTranslate01d" ft1 st3 Nothing
-testGraphTranslate01e = testEq "gt1f1a-gt1f1b" gt1f1a gt1f1b
-
-ftm2   = LookupMap [Formula st2 gt2]
-gt1f2a = setFormulae ftm2 gt1
-gt1f2b = fmap translate g1f2
-ft2    = getFormulae gt1f2b
-testGraphTranslate02a = testGraphEq "gt1f2a-gt1f2b" True gt1f2a gt1f2b
-testGraphTranslate02b = testFormulaLookup "GraphTranslate02b" ft2 st1 Nothing
-testGraphTranslate02c = testFormulaLookup "GraphTranslate02c" ft2 st2 (Just gt2)
-testGraphTranslate02d = testFormulaLookup "GraphTranslate02d" ft2 st3 Nothing
-
-ftm3   = LookupMap [Formula st1 gt1,Formula st2 gt2,Formula st3 gt3]
-gt1f3a = setFormulae ftm3 gt1
-gt1f3b = fmap translate g1f3
-ft3    = getFormulae gt1f3b
-testGraphTranslate03a = testGraphEq "gt1f3a-gt1f3b" True gt1f3a gt1f3b
-testGraphTranslate03b = testFormulaLookup "GraphTranslate03b" ft3 st1 (Just gt1)
-testGraphTranslate03c = testFormulaLookup "GraphTranslate03c" ft3 st2 (Just gt2)
-testGraphTranslate03d = testFormulaLookup "GraphTranslate03d" ft3 st3 (Just gt3)
-
-gt2f1a = gt2
-gt2f1b = fmap translate g2f1
-ft4    = getFormulae gt2f1b
-testGraphTranslate04a = testGraphEq "gt2f1a-gt2f1b" True gt2f1a gt2f1b
-testGraphTranslate04b = testFormulaLookup "GraphTranslate04b" ft4 st1 Nothing
-testGraphTranslate04c = testFormulaLookup "GraphTranslate04c" ft4 st2 Nothing
-testGraphTranslate04d = testFormulaLookup "GraphTranslate04d" ft4 st3 Nothing
-
-gt2f2a = setFormulae ftm2 gt2
-gt2f2b = fmap translate g2f2
-ft5    = getFormulae gt2f2b
-testGraphTranslate05a = testGraphEq "gt2f2a-gt2f2b" True gt2f2a gt2f2b
-testGraphTranslate05b = testFormulaLookup "GraphTranslate05b" ft5 st1 Nothing
-testGraphTranslate05c = testFormulaLookup "GraphTranslate05c" ft5 st2 (Just gt2)
-testGraphTranslate05d = testFormulaLookup "GraphTranslate05d" ft5 st3 Nothing
-
-gt2f3a = setFormulae ftm3 gt2
-gt2f3b = fmap translate g2f3
-ft6    = getFormulae gt2f3b
-testGraphTranslate06a = testGraphEq "gt2f3a-gt2f3b" True gt2f3a gt2f3b
-testGraphTranslate06b = testFormulaLookup "GraphTranslate06b" ft6 st1 (Just gt1)
-testGraphTranslate06c = testFormulaLookup "GraphTranslate06c" ft6 st2 (Just gt2)
-testGraphTranslate06d = testFormulaLookup "GraphTranslate06d" ft6 st3 (Just gt3)
-
--- Monadic translate tests, using Maybe Monad
-gt1f1aM = Just gt1
-gt1f1bM = fmapM translateM g1f1
-ft1M    = getFormulae $ fromJust gt1f1bM
-testGraphTranslate07a = testGraphEqM "gt1f1aM-gt1f1bM" True gt1f1aM gt1f1bM
-testGraphTranslate07b = testFormulaLookup "GraphTranslate07b" ft1M st1 Nothing
-testGraphTranslate07c = testFormulaLookup "GraphTranslate07c" ft1M st2 Nothing
-testGraphTranslate07d = testFormulaLookup "GraphTranslate07d" ft1M st3 Nothing
-testGraphTranslate07e = testEq "gt1f1aM-gt1f1bM" gt1f1aM gt1f1bM
-
-gt1f2aM = Just gt1f2a
-gt1f2bM = fmapM translateM g1f2
-ft2M    = getFormulae $ fromJust gt1f2bM
-testGraphTranslate08a = testGraphEqM "gt1f2aM-gt1f2bM" True gt1f2aM gt1f2bM
-testGraphTranslate08b = testFormulaLookup "GraphTranslate08b" ft2M st1 Nothing
-testGraphTranslate08c = testFormulaLookup "GraphTranslate08c" ft2M st2 (Just gt2)
-testGraphTranslate08d = testFormulaLookup "GraphTranslate08d" ft2M st3 Nothing
-testGraphTranslate08e = testEq "gt1f2aM-gt1f2bM" gt1f2aM gt1f1bM
-
-gt1f5M = fmapM translateM g1f5
-testGraphTranslate09a = testEq "GraphTranslate09a" Nothing gt1f5M
-
-testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList
-  [ testGraphTranslate01a
-  , testGraphTranslate01b, testGraphTranslate01c, testGraphTranslate01d
-  , testGraphTranslate01e
-  , testGraphTranslate02a
-  , testGraphTranslate02b, testGraphTranslate02c, testGraphTranslate02d
-  , testGraphTranslate03a
-  , testGraphTranslate03b, testGraphTranslate03c, testGraphTranslate03d
-  , testGraphTranslate04a
-  , testGraphTranslate04b, testGraphTranslate04c, testGraphTranslate04d
-  , testGraphTranslate05a
-  , testGraphTranslate05b, testGraphTranslate05c, testGraphTranslate05d
-  , testGraphTranslate06a
-  , testGraphTranslate06b, testGraphTranslate06c, testGraphTranslate06d
-  , testGraphTranslate07a
-  , testGraphTranslate07b, testGraphTranslate07c, testGraphTranslate07d
-  , testGraphTranslate07e
-  , testGraphTranslate08a
-  , testGraphTranslate08b, testGraphTranslate08c, testGraphTranslate08d
-  , testGraphTranslate08e
-  , testGraphTranslate09a
-  ]
-
-------------------------------------------------------------
---  Test merge with conflicting bnodes, including formulae
-------------------------------------------------------------
-
-testMerge :: String -> RDFGraph -> RDFGraph -> RDFGraph -> Test
-testMerge lab g1 g2 gr =
-    TestCase ( assertEquiv ("testMerge:"++lab) gr (merge g1 g2) )
-        where
-            grequiv g1 g2 = (getArcs g1) `equiv` (getArcs g2)
-            assertEquiv lab g1 g2 = assertString $
-                if grequiv g1 g2 then ""
-                else lab++"\nExpected: "++(show g1)++"\nObtained: "++(show g2)
-
-
-testEquiv :: (Eq a) => String -> [a] -> [a] -> Test
-testEquiv lab l1 l2 = TestCase $ assertBool lab (l1 `equiv` l2)
-
-tm01 = arc s1  p1 b1
-tm02 = arc b1  p1 o2
-tm03 = arc b1  p1 o3
-tm04 = arc b2  p2 b3
-tm05 = arc b3  p2 b4
-tm06 = arc bb  p2 b5
-tm07 = arc s2  p3 v1
-tm08 = arc s3  p3 v2
-tm09 = arc s4  p1 c1
-tm10 = arc c2  p1 o4
-tm11 = arc s4  p2 ba1
-tm12 = arc ba2 p2 o4
-tm13 = arc s4  p2 bn3
-tm14 = arc bn4 p2 o4
-
-tm21 = arc s1  p1 b6
-tm22 = arc b6  p1 o2
-tm23 = arc b6  p1 o3
-tm24 = arc b7  p2 b8
-tm25 = arc b8  p2 b9
-tm26 = arc bb0 p2 b10
-tm27 = arc s2  p3 v3
-tm28 = arc s3  p3 v4
-tm29 = arc s4  p1 c3
-tm30 = arc c4  p1 o4
-tm31 = arc s4  p2 ba3
-tm32 = arc ba4 p2 o4
-tm33 = arc s4  p2 bn5
-tm34 = arc bn6 p2 o4
-
-tm41  = arc s1  p1 b2
-tm42  = arc b2  p1 o2
-tm43  = arc b2  p1 o3
-tm44  = arc b4  p2 b5
-
-tm41a = arc s1  p1 b4
-tm44a = arc b5  p2 b6
-
-tm67 = arc s2  p3 v3
-tm68 = arc s3  p3 v4
-tm69 = arc s4  p1 c3
-tm70 = arc c4  p1 o4
-tm71 = arc s4  p2 ba3
-tm72 = arc ba4 p2 o4
-tm73 = arc s4  p2 bn5
-tm74 = arc bn6 p2 o4
-
-gm1 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08
-                       ,tm09,tm10,tm11,tm12,tm13,tm14
-                       ]
-        }
-
-gm11  = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08
-                       ,tm09,tm10,tm11,tm12,tm13,tm14
-                       ,tm21,tm22,tm23,tm24,tm25,tm26,tm27,tm28
-                       ,tm29,tm30,tm31,tm32,tm33,tm34
-                       ]
-        }
-
-gm2 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01]
-        }
-
-gm2f = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm41]
-        }
-
-gm22 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01,tm41]
-        }
-
-gm3 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm04]
-        }
-
-gm3f = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm44]
-        }
-
-gm33 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm04,tm44]
-        }
-
-gm4 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01,tm04]
-        }
-
-gm44 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm01,tm04,tm41a,tm44a]
-        }
-
-gm5 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula b1 gm2]
-        , statements = [tm01,tm02,tm03]
-        }
-
-gm55 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula b1 gm2,Formula b2 gm2f]
-        , statements = [tm01,tm02,tm03,tm41,tm42,tm43]
-        }
-
-gm6 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula ba1 gm2,Formula bn3 gm3]
-        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14]
-        }
-
-gm66 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap
-                       [Formula ba1 gm2,Formula bn3 gm3
-                       ,Formula ba3 gm2f,Formula bn5 gm3f
-                       ]
-        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14
-                       ,tm67,tm68,tm69,tm70,tm71,tm72,tm73,tm74
-                       ]
-        }
-
-
-tm81  = arc b1 p1 v1
-tm82  = arc b2 p2 v2
-tm811 = arc b1 p1 v3
-tm821 = arc b2 p2 v4
-tm812 = arc b1 p1 vb3
-tm822 = arc b2 p2 vb4
-
-gm81 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm81,tm82]
-        }
-
-gm82 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm811,tm821]
-        }
-gm82a = remapLabels [v1,v2] [v1,v2,b1,b2] id gm81
-gm82b1 = remapLabelList [v1,v2] [v1,v2,b1,b2]
-gm82b2 = [(v1,v3),(v2,v4)]
-
-gm83 = NSGraph
-        { namespaces = nslist
-        , formulae   = emptyFormulaMap
-        , statements = [tm811,tm821]
-        }
-gm83a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm81
-
-gm84  = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula b1 gm81,Formula v2 gm81]
-        , statements = [tm81,tm82]
-        }
-
-gm85 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula b1 gm82,Formula v4 gm82]
-        , statements = [tm811,tm821]
-        }
-gm85a = remapLabels [v1,v2] [v1,v2,b1,b2] id gm84
-
-gm86 = NSGraph
-        { namespaces = nslist
-        , formulae   = LookupMap [Formula b1 gm82,Formula vb4 gm82]
-        , statements = [tm812,tm822]
-        }
-gm86a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm84
-
-testMerge01 = testMerge "01" gm1 gm1 gm11
-testMerge02 = testMerge "02" gm2 gm2 gm22
-testMerge03 = testMerge "03" gm3 gm3 gm33
-testMerge04 = testMerge "04" gm4 gm4 gm44
-testMerge05 = testMerge "05" gm5 gm5 gm55
-testMerge06 = testMerge "06" gm6 gm6 gm66
-
-testRemap07 = testGraphEq "Remap07" True gm82 gm82a
-testRemapList07 = testEquiv "testRemapList07" gm82b2 gm82b1
-testRemap08 = testGraphEq "Remap08" True gm83 gm83a
-testRemap09 = testGraphEq "Remap09" True gm85 gm85a
-testRemap10 = testGraphEq "Remap10" True gm86 gm86a
-
-testMergeSuite = TestList
-  [ testMerge01
-  , testMerge02
-  , testMerge03
-  , testMerge04
-  , testMerge05
-  , testMerge06
-  , testRemap07
-  , testRemapList07
-  , testRemap08
-  , testRemap09
-  , testRemap10
-  ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ testLangEqSuite
-  , testNodeEqSuite
-  , testNodeClassSuite
-  , testNodeLocalSuite
-  , testNewNodeSuite
-  , testNodeOrdSuite
-  , testLabelOtherSuite
-  , testStmtEqSuite
-  , testGraphEqSuite
-  , testGraphEqSelSuite
-  , testGraphFormulaSuite
-  , testGraphTranslateSuite
-  , testMergeSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-geq  = testGraphEqSuite
-nord = testNodeOrdSuite
-gtr  = testGraphTranslateSuite
-
-gmm g1 g2 = grMatchMap g1 g2
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFGraphTest.hs,v $
--- $Author: graham $
--- $Revision: 1.32 $
--- $Log: RDFGraphTest.hs,v $
--- Revision 1.32  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.31  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.30  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.29  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.28  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.27  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.26  2003/10/01 00:36:25  graham
--- Added RDFGraph method to test for container membership property label.
--- Added RDFQuery filter function to select container membership properties.
---
--- Revision 1.25  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.24  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.23  2003/07/02 21:27:30  graham
--- Graph closure with instance rule tested.
--- About to change ProofTest for graph forward chaining to return
--- a single result graph.
---
--- Revision 1.22  2003/07/01 14:20:30  graham
--- Added instance entailment to proof check module.
---
--- Revision 1.21  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.20  2003/06/17 15:43:35  graham
--- remapNodes now accepts a node-mapping function rather than just
--- a Boolean to control conversion of query variable nodes to blank
--- nodes, and who knows what else.
---
--- Revision 1.19  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.18  2003/06/12 00:49:05  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
--- Revision 1.17  2003/06/10 17:38:34  graham
--- Remove some unneeded calss constraints from data type declarations
--- Reworked NSGraph to be an instance of Functor, replacing function
--- gmap with fmap.  Graph formulae are still not handled well:  the data types
--- will need re-working so that a "Formula lb" type constructor can be
--- introduced having the correct (* -> *) kind to be a Functor.
---
--- Revision 1.16  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.15  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.14  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.13  2003/05/27 19:15:50  graham
--- Graph merge (with blank node renaming) complete and passes tests.
---
--- Revision 1.12  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.11  2003/05/23 19:33:36  graham
--- Added and tested RDF graph label translation functions
---
--- Revision 1.10  2003/05/14 16:50:32  graham
--- Graph matching seems solid now:
--- RDFGraphTest and N3ParserTest pass all tests
--- Updated TODO file with comments from code
---
--- Revision 1.9  2003/05/08 18:55:36  graham
--- Updated graph matching module to deal consistently
--- with graphs containing formulae.  All graph tests now
--- run OK, but the GraphMatch module is a mess and
--- desperately needs restructuring.  Also, graph matching
--- performance needs to be improved.
---
--- Revision 1.8  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.7  2003/05/07 19:25:00  graham
--- Restructured formula handling in RDF graph
---
--- Revision 1.6  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.5  2003/04/17 00:35:39  graham
--- Added module N3ParserTest
--- N3parser is mostly working
--- Formulae remain to test
---
--- Revision 1.4  2003/04/15 21:40:54  graham
--- N3Parser compiles
--- Some small changes to RDFGraph
--- Added some QName methods
---
--- Revision 1.3  2003/04/10 20:08:39  graham
--- Reorganized RDFGraph naming (RDFGraphTest OK)
--- Progressing N3Parser
---
--- Revision 1.2  2003/04/10 15:06:30  graham
--- RDFGraph now passes all test cases
---
--- Revision 1.1  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
--- Revision 1.1  2003/03/12 23:00:43  graham
--- Graph model coded and working, except for graph isomorphism test.
---
− Swish/HaskellRDF/RDFProof.hs 
@@ -1,481 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}
-{-# OPTIONS -XUndecidableInstances #-}
---------------------------------------------------------------------------------
---  $Id: RDFProof.hs,v 1.22 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFProof
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + multi-parameter classes
---
---  This module instantiates the 'Proof' framework for
---  constructing proofs over RDFGraph expressions.
---  The intent is that this can be used to test some
---  correspondences between the RDF Model theory and
---  corresponding proof theory based on closure rules
---  applied to the graph, per <http://www.w3.org/TR/rdf-mt/>.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFProof
-    ( RDFProof, RDFProofStep
-    , makeRDFProof, makeRDFProofStep
-    , makeRdfInstanceEntailmentRule
-    , makeRdfSubgraphEntailmentRule
-    , makeRdfSimpleEntailmentRule )
-where
-
-import Swish.HaskellRDF.RDFQuery
-    (  rdfQueryInstance
-    , rdfQuerySubs 
-    )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFRuleset )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..), RDFGraph
-    --, makeBlank
-    , merge , allLabels , remapLabelList
-    {-, newNode, newNodes
-    , toRDFGraph -}, emptyRDFGraph
-    )
-
-import Swish.HaskellRDF.VarBinding
-    (  makeVarBinding
-    )
-
-import Swish.HaskellRDF.Proof
-    ( Proof(..), Step(..) )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Rule(..) )--import Swish.HaskellUtils.Namespace-    ( ScopedName(..)-    )-
-import Swish.HaskellRDF.GraphClass
-    ( Label(..), LDGraph(..), replaceArcs )
-
-import Swish.HaskellUtils.LookupMap
-    ( makeLookupMap, mapFind )
-
-import Swish.HaskellUtils.ListHelpers
-    ( subset
-    , powerSet
-    , powerSequences_len
-    , flist
-    )
-
-------------------------------------------------------------
---  Type instantiation of Proof framework for RDFGraph data
-------------------------------------------------------------
---
---  This is a partial instantiation of the proof framework.
---  Details for applying inference rules are specific to the
---  graph instance type.
-
-------------------------------------------------------------
---  Proof datatypes for graph values
-------------------------------------------------------------
-
--- |Instances of LDGraph are also instance of the
---  Expression class, for which proofs can be constructed.
---  The empty RDF graph is always True (other enduring
---  truths are asserted as axioms.
-instance (Label lb, LDGraph lg lb) => Expression (lg lb) where
-    isValid gr = null $ getArcs gr
-
-------------------------------------------------------------
---  Define RDF-specific types for proof framework
-------------------------------------------------------------
-
-type RDFProof     = Proof RDFGraph
-
-type RDFProofStep = Step RDFGraph
-
-------------------------------------------------------------
---  Helper functions for constructing proofs on RDF graphs
-------------------------------------------------------------
-
--- |Make an RDF graph proof step
---
---  rul     is a rule to use for this step
---  ants    is a list of antecedent RDF formulae for this step
---  con     is an RDF formula that is the consequent for this step
---
-makeRDFProofStep ::
-    RDFRule -> [RDFFormula] -> RDFFormula
-    -> RDFProofStep
-makeRDFProofStep rul ants con = Step
-    { stepRule = rul
-    , stepAnt  = ants
-    , stepCon  = con
-    }
-
--- |Make an RDF proof
---
---  rsets   is a list of RDF rulesets that constitute a proof context
---          for this proof.
---  base    is an initial statement from which the goal is claimed
---          to be proven.
---  goal    is a statement that is claimed to be proven.
---
-makeRDFProof ::
-    [RDFRuleset] -> RDFFormula -> RDFFormula
-    -> [RDFProofStep]
-    -> RDFProof
-makeRDFProof rsets base goal steps = Proof
-    { proofContext = rsets
-    , proofInput   = base
-    , proofResult  = goal
-    , proofChain   = steps
-    }
-
-------------------------------------------------------------
---  RDF instance entailment inference rule
-------------------------------------------------------------
-
--- |Make an inference rule dealing with RDF instance entailment;
---  i.e. entailments that are due to replacement of a URI or literal
---  node with a blank node.
---
---  The part of this rule expected to be useful is 'checkInference'.
---  The 'fwdApply' and 'bwdApply' functions defined here may return
---  rather large results if applied to graphs with many variables or
---  a large vocabulary, and are defined for experimentation.
---
---  Forward and backward chaining is performed with respect to a
---  specified vocabulary.  In the case of backward chaining, it would
---  otherwise be impossible to bound the options thus generated.
---  In the case of forward chaining, it is often not desirable to
---  have the properties generalized.  If forward or backward backward
---  chaining will not be used, supply an empty vocabulary.
---  Note:  graph method 'allNodes' can be used to obtain a list of all
---  the subjects and objuects used ina  graph, not counting nested
---  formulae;  use a call of the form:
---    allNodes (not . labelIsVar) graph
-makeRdfInstanceEntailmentRule :: ScopedName -> [RDFLabel] -> RDFRule
-makeRdfInstanceEntailmentRule name vocab = newrule
-    where
-        newrule = Rule
-            { ruleName = name
-            , fwdApply = rdfInstanceEntailFwdApply vocab
-            , bwdApply = rdfInstanceEntailBwdApply vocab
-            , checkInference = rdfInstanceEntailCheckInference
-            }
-
---  Instance entailment forward chaining
---
---  Note:  unless the initial graph is small, the total result
---  here could be very large.  The existential generalizations are
---  sequenced in increasing number of substitutions applied.
---  This sequencing is determined by the powerset function used,
---  which generates subsets in increasing order of size
---  (see module 'ListHelpers').
---
---  The instances generated are all copies of the merge of the
---  supplied graphs, with some or all of the non-variable nodes
---  replaced by blank nodes.
-rdfInstanceEntailFwdApply :: [RDFLabel] -> [RDFGraph] -> [RDFGraph]
-rdfInstanceEntailFwdApply vocab ante =
-    let
-        --  Merge antecedents to single graph, renaming bnodes if needed.
-        --  (Null test and using 'foldl1' to avoid merging if possible.)
-        mergeGraph  = if null ante then emptyRDFGraph
-                        else (foldl1 merge ante)
-        --  Obtain lists of variable and non-variable nodes
-        --  (was: nonvarNodes = allLabels (not . labelIsVar) mergeGraph)
-        nonvarNodes = vocab
-        varNodes    = allLabels (labelIsVar) mergeGraph
-        --  Obtain list of possible remappings for non-variable nodes
-        mapList     = remapLabelList nonvarNodes varNodes
-        mapSubLists = powerSet mapList
-        mapGr ls gr = fmap (\l -> mapFind l l (makeLookupMap ls)) gr
-    in
-        --  Return all remappings of the original merged graph
-        flist (map mapGr mapSubLists) mergeGraph
-
---  Instance entailment backward chaining (for specified vocabulary)
---
---  [[[TODO:  this is an incomplete implementation, there being no
---  provision for instantiating some variables and leaving others
---  alone.  This can be overcome in many cases by combining instance
---  and subgraph chaining.
---  Also, there is no provision for instantiating some variables in
---  a triple and leaving others alone.  This may be fixed later if
---  this function is really needed to be completely faithful to the
---  precise notion of instance entailment.]]]
-rdfInstanceEntailBwdApply :: [RDFLabel] -> RDFGraph -> [[RDFGraph]]
-rdfInstanceEntailBwdApply vocab cons =
-    let
-        --  Obtain list of variable nodes
-        varNodes     = allLabels (labelIsVar) cons
-        --  Generate a substitution for each combination of variable
-        --  and vocabulary node.
-        varBindings  = map (makeVarBinding . zip varNodes) vocSequences
-        vocSequences = powerSequences_len (length varNodes) vocab
-    in
-        --  Generate a substitution for each combination of variable
-        --  and vocabulary:
-        [ rdfQuerySubs [v] cons | v <- varBindings ]
-
---  Instance entailment inference checker
-rdfInstanceEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
-rdfInstanceEntailCheckInference ante cons =
-    let
-        mante = if null ante then emptyRDFGraph -- merged antecedents
-                    else (foldl1 merge ante)
-        qvars = rdfQueryInstance cons mante     -- all query matches
-        bsubs = rdfQuerySubs qvars cons         -- all back substitutions
-    in
-        --  Return True if any back-substitution matches the original
-        --  merged antecendent graph.
-        or (map (mante ==) bsubs)
-
---  Instance entailment notes.
---
---  Relation to simple entailment (s-entails):
---
---  (1) back-substitution yields original graph
---  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o1  by [_:o1/ex:o1]
---
---  (2) back-substitution yields original graph
---  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]
---  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/_:o1]
---
---  (3) back-substitution does not yield original graph
---  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]
---  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/ex:o1]
---
---  (4) consider
---  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 ex:o1
---  ex:s1 ex:p1 ex:o2             ex:s1 ex:p1 ex:o2
---  ex:s1 ex:p1 ex:o3             ex:s1 ex:p1 _:o1
---                                ex:s1 ex:p1 _:o2
---  where [_:o1/ex:o1,_:o2/ex:o2] yields a simple entailment but not
---  an instance entailment, but [_:o1/ex:o3,_:o2/ex:o3] is also
---  (arguably) an instance entailment.  Therefore, it is not sufficient
---  to look only at the "largest" substitutions to determine instance
---  entailment.
---
---  All this means that when checking for instance entailment by
---  back substitution, all of the query results must be checked.
---  This seems clumsy.  If this function is heavily used with
---  multiple query matches, a modified query that uses each
---  triple of the target graph exactly once may be required.
-
-------------------------------------------------------------
---  RDF subgraph entailment inference rule
-------------------------------------------------------------
-
--- |Make an inference rule dealing with RDF subgraph entailment.
---  The part of this rule expected to be useful is 'checkInference'.
---  The 'fwdApply' function defined here may return rather large
---  results.  But in the name of completeness and experimentation
---  with the possibilities of lazy evaluation, it has been defined.
---
---  Backward chaining is not performed, as there is no reasonable way
---  to choose a meaningful supergraph of that supplied.
-makeRdfSubgraphEntailmentRule :: ScopedName -> RDFRule
-makeRdfSubgraphEntailmentRule name = newrule
-    where
-        newrule = Rule
-            { ruleName = name
-            , fwdApply = rdfSubgraphEntailFwdApply
-            , bwdApply = const []
-            , checkInference = rdfSubgraphEntailCheckInference
-            }
-
---  Subgraph entailment forward chaining
---
---  Note:  unless the initial graph is small, the total result
---  here could be very large.  The subgraphs are sequenced in
---  increasing size of the sub graph.  This sequencing is determined
---  by the 'powerSet' function used which generates subsets in
---  increasing order of size (see module 'ListHelpers').
-rdfSubgraphEntailFwdApply :: [RDFGraph] -> [RDFGraph]
-rdfSubgraphEntailFwdApply ante =
-    let
-        --  Merge antecedents to single graph, renaming bnodes if needed.
-        --  (Null test and using 'foldl1' to avoid merging if possible.)
-        mergeGraph  = if null ante then emptyRDFGraph
-                        else (foldl1 merge ante)
-    in
-        --  Return all subgraphs of the full graph constructed above
-        map (replaceArcs mergeGraph) (init $ powerSet $ getArcs mergeGraph)
-
---  Subgraph entailment inference checker
---
---  This is of dubious utiltiy, as it doesn't allow for node renaming.
---  The simple entailment inference rule is probably more useful here.
-rdfSubgraphEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
-rdfSubgraphEntailCheckInference ante cons =
-    let
-        --  Combine antecedents to single graph, renaming bnodes if needed.
-        --  (Null test and using 'foldl1' to avoid merging if possible.)
-        fullGraph  = if null ante then emptyRDFGraph
-                        else (foldl1 add ante)
-    in
-        --  Check each consequent graph arc is in the antecedent graph
-        getArcs cons `subset` getArcs fullGraph
-
-------------------------------------------------------------
---  RDF simple entailment inference rule
-------------------------------------------------------------
-
--- |Make an inference rule dealing with RDF simple entailment.
---  The part of this rule expected to be useful is 'checkInference'.
---  The 'fwdApply' and 'bwdApply' functions defined return null
---  results, indicating that they are not useful for the purposes
---  of proof discovery.
-makeRdfSimpleEntailmentRule :: ScopedName -> RDFRule
-makeRdfSimpleEntailmentRule name = newrule
-    where
-        newrule = Rule
-            { ruleName = name
-            , fwdApply = const []
-            , bwdApply = const []
-            , checkInference = rdfSimpleEntailCheckInference
-            }
-
---  Simple entailment inference checker
---
---  Note:  antecedents here are presumed to share bnodes.
---         (Use 'merge' instead of 'add' for non-shared bnodes)
---
-rdfSimpleEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
-rdfSimpleEntailCheckInference ante cons =
-    let agr = if null ante then emptyRDFGraph else foldl1 add ante
-    in
-        not $ null $ rdfQueryInstance cons agr
-
-{- original..
-        not $ null $ rdfQueryInstance cons (foldl1 merge ante)
--}
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFProof.hs,v $
--- $Author: graham $
--- $Revision: 1.22 $
--- $Log: RDFProof.hs,v $
--- Revision 1.22  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.21  2003/12/16 07:05:37  graham
--- Working on updated RDFProofContext
---
--- Revision 1.20  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.19  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.18  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.17  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.16  2003/09/30 20:02:39  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.15  2003/09/30 16:39:41  graham
--- Refactor proof code to use new ruleset logic.
--- Moved some support code from RDFProofCheck to RDFRuleset.
---
--- Revision 1.14  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.13  2003/07/02 21:27:30  graham
--- Graph closure with instance rule tested.
--- About to change ProofTest for graph forward chaining to return
--- a single result graph.
---
--- Revision 1.12  2003/07/01 14:20:30  graham
--- Added instance entailment to proof check module.
---
--- Revision 1.11  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.10  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.9  2003/06/25 21:16:53  graham
--- Reworked N3 formatting logic to support proof display.
--- Basic proof display is working.
---
--- Revision 1.8  2003/06/25 09:52:25  graham
--- Replaced Rule class with algebraic data type
---
--- Revision 1.7  2003/06/24 23:08:18  graham
--- Replaced Rule class with algebraic data type
---
--- Revision 1.6  2003/06/24 19:56:31  graham
--- Basic proof-check now works
---
--- Revision 1.5  2003/06/19 19:49:07  graham
--- RDFProofCheck compiles, but test fails
---
--- Revision 1.4  2003/06/18 18:40:08  graham
--- Basic proof backchaining tests OK.
--- Next:  add filtering on variable bindings.
---
--- Revision 1.3  2003/06/18 01:29:29  graham
--- Fixed up some problems with backward chaining queries.
--- Query test cases still to complete.
--- Proof incomplete.
---
--- Revision 1.2  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.1  2003/06/12 00:49:06  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
− Swish/HaskellRDF/RDFProofContext.hs 
@@ -1,890 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFProofContext.hs,v 1.13 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFProofContext
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains proof-context declarations based on
---  the RDF, RDFS and RDF datatyping semantics specifications.
---  These definitions consist of namespaces (for identification
---  in proofs), axioms and inference rules.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFProofContext
-    ( rulesetRDF
-    , rulesetRDFS
-    , rulesetRDFD )
-where
-
-import Swish.HaskellRDF.BuiltInDatatypes
-    ( findRDFDatatype )
-
-import Swish.HaskellRDF.RDFProof
-    ( makeRdfSubgraphEntailmentRule
-    , makeRdfSimpleEntailmentRule )
-
-import Swish.HaskellRDF.RDFRuleset 
-    ( RDFFormula 
-    , makeRDFFormula
-    , makeN3ClosureRule
-    , makeN3ClosureSimpleRule
-    , makeN3ClosureModifyRule
-    , makeN3ClosureAllocatorRule
-    , makeNodeAllocTo )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding
-    , RDFVarBindingModify
-    , RDFVarBindingFilter
-    , rdfVarBindingUriRef, rdfVarBindingBlank
-    , rdfVarBindingLiteral
-    , rdfVarBindingUntypedLiteral 
-    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
-    , rdfVarBindingMemberProp
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , isUri, isDatatyped
-    , getLiteralText )
-
-import Swish.HaskellRDF.VarBinding
-    ( applyVarBinding
-    , addVarBinding
-    , VarBindingModify(..)
-    , makeVarFilterModify
-    , varFilterDisjunction-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( makeRuleset )
-
-import Swish.HaskellRDF.Datatype
-    ( typeMkCanonicalForm )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..), ScopedName(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , scopeRDF
-    , scopeRDFS
-    , scopeRDFD
-    )
-
-import Data.Maybe
-    ( isJust, fromJust )
-
-import Control.Monad
-    ( liftM )
-
-------------------------------------------------------------
---  Define query binding filter auxiliaries
-------------------------------------------------------------
-
-makeFormula :: Namespace -> String -> String -> RDFFormula
-makeFormula scope local gr =
-    makeRDFFormula scope local (prefixRDF++gr)
-
-requireAny :: [RDFVarBindingFilter] -> RDFVarBindingFilter
-requireAny rs = varFilterDisjunction rs
-
-isLiteralV            :: String -> RDFVarBindingFilter-isLiteralV    ('?':l) = rdfVarBindingLiteral        (Var l)
--isUntypedLitV         :: String -> RDFVarBindingFilter-isUntypedLitV ('?':l) = rdfVarBindingUntypedLiteral (Var l)
--isXMLLitV             :: String -> RDFVarBindingFilter-isXMLLitV     ('?':x) = rdfVarBindingXMLLiteral     (Var x)
--isUriRefV             :: String -> RDFVarBindingFilter-isUriRefV     ('?':u) = rdfVarBindingUriRef         (Var u)
--isBlankV              :: String -> RDFVarBindingFilter-isBlankV      ('?':b) = rdfVarBindingBlank          (Var b)
--isDatatypedV                  :: String -> String -> RDFVarBindingFilter-isDatatypedV  ('?':d) ('?':l) = rdfVarBindingDatatyped (Var d) (Var l)
--isMemberPropV         :: String -> RDFVarBindingFilter-isMemberPropV ('?':l) = rdfVarBindingMemberProp     (Var l)
-
--allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify
-allocateTo bv av = makeNodeAllocTo (vn bv) (vn av)
-    where
-        vn ('?':n) = Var n
-
---  Create new binding for datatype
-valueSame :: String -> String -> String -> String -> RDFVarBindingModify
-valueSame val1 typ1 val2 typ2 =
-    sameDatatypedValue (vn val1) (vn typ1) (vn val2) (vn typ2)
-    where
-            vn ('?':n) = Var n
-
---  Variable binding modifier to create new binding to a canonical
---  form of a datatyped literal.
-sameDatatypedValue ::
-    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel -> RDFVarBindingModify
-sameDatatypedValue val1 typ1 val2 typ2 = VarBindingModify
-        { vbmName   = ScopedName namespaceRDFD "sameValue"
-        , vbmApply  = sameDatatypedValueApplyAll val1 typ1 val2 typ2
-        , vbmVocab  = [val1,typ1,val2,typ2]
-        , vbmUsage  = [[val2]]
-        }
-
-sameDatatypedValueApplyAll ::
-    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel
-    -> [RDFVarBinding]
-    -> [RDFVarBinding]
-sameDatatypedValueApplyAll val1 typ1 val2 typ2 vbinds =
-    {-
-    trace "\nsameDatatypedValueApplyAll:" $
-    seq (traceShow "\nval1:" val1) $
-    seq (traceShow "\ntyp1:" typ1) $
-    seq (traceShow "\nval2:" val2) $
-    seq (traceShow "\ntyp2:" typ2) $
-    seq (traceShow "\nvbinds:" vbinds) $
-    trace "\n" $
-    -}
-    concatMap (sameDatatypedValueApply val1 typ1 val2 typ2) vbinds
-
---  Auxiliary function that handles variable binding updates
---  for sameDatatypedValue
-sameDatatypedValueApply ::
-    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel
-    -> RDFVarBinding
-    -> [RDFVarBinding]
-sameDatatypedValueApply val1 typ1 val2 typ2 vbind =
-    {-
-    trace "\nsameDatatypedValueApply:" $
-    seq (traceShow "\nval1:"   val1) $
-    seq (traceShow "\ntyp1:"   typ1) $
-    seq (traceShow "\nval2:"   val2) $
-    seq (traceShow "\ntyp2:"   typ2) $
-    seq (traceShow "\nvbind:"  vbind) $
-    seq (traceShow "\nresult:" result) $
-    trace "\n" $
-    -}
-    result
-    where
-        v1    = applyVarBinding vbind val1
-        t1    = applyVarBinding vbind typ1
-        t2    = applyVarBinding vbind typ2
-        sametype = getCanonical v1 t1 t2
-        result   =
-            if (isUri t1) && (isUri t2) then
-                if (t1 == t2) then
-                    if isJust sametype then
-                        [addVarBinding val2 (fromJust $ sametype) vbind]
-                    else
-                        []
-                else
-                    error "subtype conversions not yet defined"
-            else
-                []
-
-getCanonical :: RDFLabel -> RDFLabel -> RDFLabel -> Maybe RDFLabel
-getCanonical v1 t1 t2 =
-    if (isDatatyped dqn1 v1) && (isJust mdt1) then
-        liftM mkLit $ typeMkCanonicalForm dt1 (getLiteralText v1)
-    else
-        Nothing
-    where
-        dqn1  = case t1 of { (Res dqnam) -> dqnam }
-        dqn2  = case t2 of { (Res dqnam) -> dqnam }
-        mdt1  = findRDFDatatype dqn1
-        dt1   = fromJust mdt1
-        mkLit st = Lit st (Just dqn2)
-
-{- -- Test data
-qnamint = ScopedName namespaceXSD "integer"
-xsdint  = Res qnamint
-lab010  = Lit "010" (Just qnamint)
-can010  = getCanonical lab010 xsdint xsdint
-nsex    = Namespace "ex" "http://example.org/"
-resexp  = Res (ScopedName nsex "p")
-resexs  = Res (ScopedName nsex "s")
-
-vara = Var "a"
-varb = Var "b"
-varc = Var "c"
-vard = Var "d"
-varp = Var "p"
-vars = Var "s"
-vart = Var "t"
-
-vb1  = makeVarBinding [(vara,lab010),(varb,xsdint),(vard,xsdint)]
-vb2  = sameDatatypedValueApply vara varb varc vard vb1
-vb3  = vbmApply (sameDatatypedValue vara varb varc vard) [vb1]
-vb3t = vb3 == vb2
-vb4  = vbmApply (valueSame "?a" "?b" "?c" "?d") [vb1]
-vb4t = vb4 == vb2
-vb5  = vbmApply (valueSame "?a" "?b" "?c" "?b") [vb1]
-vb5t = vb5 == vb2
-
-vb6  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)]
-vb7  = vbmApply (valueSame "?s" "?d" "?t" "?d") [vb6]
-vb8  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)
-                      ,(vart,fromJust can010)]
-vb8t = vb7 == [vb8]
--- -}
-
-------------------------------------------------------------
---  Common definitions
-------------------------------------------------------------
-
-prefixRDF :: String-prefixRDF =
-    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" ++
-    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++
-    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
-    " \n"
-
-------------------------------------------------------------
---  Define RDF axioms
-------------------------------------------------------------
-
--- scopeRDF  = Namespace "rs-rdf"  "http://id.ninebynine.org/2003/Ruleset/rdf#"
-
---  RDF axioms (from RDF semantics document, section 3.1)
---
---  (See also, container property rules below)
---
-rdfa1 :: RDFFormula-rdfa1 = makeFormula scopeRDF "a1" "rdf:type      rdf:type rdf:Property ."
--rdfa2 :: RDFFormula-rdfa2 = makeFormula scopeRDF "a2" "rdf:subject   rdf:type rdf:Property ."
--rdfa3 :: RDFFormula-rdfa3 = makeFormula scopeRDF "a3" "rdf:predicate rdf:type rdf:Property ."
--rdfa4 :: RDFFormula-rdfa4 = makeFormula scopeRDF "a4" "rdf:object    rdf:type rdf:Property ."
--rdfa5 :: RDFFormula-rdfa5 = makeFormula scopeRDF "a5" "rdf:first     rdf:type rdf:Property ."
--rdfa6 :: RDFFormula-rdfa6 = makeFormula scopeRDF "a6" "rdf:rest      rdf:type rdf:Property ."
--rdfa7 :: RDFFormula-rdfa7 = makeFormula scopeRDF "a7" "rdf:value     rdf:type rdf:Property ."
--rdfa8 :: RDFFormula-rdfa8 = makeFormula scopeRDF "a8" "rdf:nil       rdf:type rdf:List ."
-
-axiomsRDF :: [RDFFormula]-axiomsRDF =
-    [ rdfa1,  rdfa2,  rdfa3,  rdfa4,  rdfa5
-    , rdfa6,  rdfa7,  rdfa8
-    ]
-
-------------------------------------------------------------
---  Define RDF rules
-------------------------------------------------------------
-
---  RDF subgraph entailment (from RDF semantics document section 2)
---
--- rdfsub :: Swish.HaskellRDF.RDFRuleset.RDFRule 
-rdfsub = makeRdfSubgraphEntailmentRule (ScopedName scopeRDF "sub")
-
---  RDF simple entailment (from RDF semantics document section 7.1)
---  (Note: rules se1 and se2 are combined here, because the scope of
---  the "allocatedTo" modifier is the application of a single rule.)
---
-rdfse = makeRdfSimpleEntailmentRule (ScopedName scopeRDF "se")
-
---  RDF bnode-for-literal assignments (from RDF semantics document section 7.1)
---
-rdflg = makeN3ClosureAllocatorRule scopeRDF "lg"
-            "?x  ?a ?l . "
-            "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."
-            (makeVarFilterModify $ isLiteralV "?l")
-            (allocateTo "?b" "?l")
-
---  RDF bnode-for-literal back-tracking (from RDF semantics document section 7.1)
---
-rdfgl = makeN3ClosureSimpleRule scopeRDF "gl"
-            "?x  ?a ?l . ?b rdf:_allocatedTo ?l . "
-            "?x  ?a ?b ."
-
---  RDF entailment rules (from RDF semantics document section 7.2)
---
---  (Note, statements with property rdf:_allocatedTo are introduced to
---  track bnodes introduced according to rule rdflf.)
---
-rdfr1 = makeN3ClosureSimpleRule scopeRDF "r1"
-            "?x ?a ?y ."
-            "?a rdf:type rdf:Property ."
-
-rdfr2 = makeN3ClosureRule scopeRDF "r2"
-            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
-            "?b rdf:type rdf:XMLLiteral ."
-            (makeVarFilterModify $ isXMLLitV "?l")
-
---  Container property axioms (from RDF semantics document section 3.1)
---
---  (Using here an inference rule with a filter in place of an axiom schema)
---
---  This is a restricted form of the given axioms, in that the axioms
---  are asserted only for container membership terms that appear in
---  the graph.
---
---  (This may be very inefficient for forward chaining when dealing with
---  large graphs:  may need to look at query logic to see if the search for
---  container membership properties can be optimized.  This may call for a
---  custom inference rule.)
---
-rdfcp1 = makeN3ClosureRule scopeRDF "cp1"
-            "?x  ?c ?y . "
-            "?c rdf:type rdf:Property ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfcp2 = makeN3ClosureRule scopeRDF "cp2"
-            "?c  ?p ?y . "
-            "?c rdf:type rdf:Property ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfcp3 = makeN3ClosureRule scopeRDF "cp3"
-            "?x  ?p ?c . "
-            "?c rdf:type rdf:Property ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
---  Collect RDF rules
---
-rulesRDF =
-    [ rdfsub,     rdfse
-    , rdflg,      rdfgl
-    , rdfr1,      rdfr2
-    , rdfcp1,     rdfcp2,     rdfcp3
-    ]
-
---  Define ruleset for RDF inference
-
-rulesetRDF = makeRuleset scopeRDF axiomsRDF rulesRDF
-
-------------------------------------------------------------
---  Define RDFS axioms
-------------------------------------------------------------
-
--- scopeRDFS = Namespace "rdfs" "http://id.ninebynine.org/2003/Ruleset/rdfs#"
-
---  RDFS axioms (from RDF semantics document, section 4.1)
---
---  (See also, container property rules below)
---
-
-rdfsa01 :: RDFFormula-rdfsa01 = makeFormula scopeRDFS "a01"
-    "rdf:type           rdfs:domain rdfs:Resource ."
-
-rdfsa02 :: RDFFormula-rdfsa02 = makeFormula scopeRDFS "a02"
-    "rdf:type           rdfs:range  rdfs:Class ."
-
-rdfsa03 :: RDFFormula-rdfsa03 = makeFormula scopeRDFS "a03"
-    "rdfs:domain        rdfs:domain rdf:Property ."
-
-rdfsa04 :: RDFFormula-rdfsa04 = makeFormula scopeRDFS "a04"
-    "rdfs:domain        rdfs:range  rdfs:Class ."
-
-rdfsa05 :: RDFFormula-rdfsa05 = makeFormula scopeRDFS "a05"
-    "rdfs:range         rdfs:domain rdf:Property ."
-
-rdfsa06 :: RDFFormula-rdfsa06 = makeFormula scopeRDFS "a06"
-    "rdfs:range         rdfs:range  rdfs:Class ."
-
-rdfsa07 :: RDFFormula-rdfsa07 = makeFormula scopeRDFS "a07"
-    "rdfs:subPropertyOf rdfs:domain rdf:Property ."
-
-rdfsa08 :: RDFFormula-rdfsa08 = makeFormula scopeRDFS "a08"
-    "rdfs:subPropertyOf rdfs:range  rdf:Property ."
-
-rdfsa09 :: RDFFormula-rdfsa09 = makeFormula scopeRDFS "a09"
-    "rdfs:subClassOf    rdfs:domain rdfs:Class ."
-
-rdfsa10 :: RDFFormula-rdfsa10 = makeFormula scopeRDFS "a10"
-    "rdfs:subClassOf    rdfs:range  rdfs:Class ."
-
-rdfsa11 :: RDFFormula-rdfsa11 = makeFormula scopeRDFS "a11"
-    "rdf:subject        rdfs:domain rdf:Statement ."
-
-rdfsa12 :: RDFFormula-rdfsa12 = makeFormula scopeRDFS "a12"
-    "rdf:subject        rdfs:range  rdfs:Resource ."
-
-rdfsa13 :: RDFFormula-rdfsa13 = makeFormula scopeRDFS "a13"
-    "rdf:predicate      rdfs:domain rdf:Statement ."
-
-rdfsa14 :: RDFFormula-rdfsa14 = makeFormula scopeRDFS "a14"
-    "rdf:predicate      rdfs:range  rdfs:Resource ."
-
-rdfsa15 :: RDFFormula-rdfsa15 = makeFormula scopeRDFS "a15"
-    "rdf:object         rdfs:domain rdf:Statement ."
-
-rdfsa16 :: RDFFormula-rdfsa16 = makeFormula scopeRDFS "a16"
-    "rdf:object         rdfs:range  rdfs:Resource ."
-
-rdfsa17 :: RDFFormula-rdfsa17 = makeFormula scopeRDFS "a17"
-    "rdfs:member        rdfs:domain rdfs:Resource ."
-
-rdfsa18 :: RDFFormula-rdfsa18 = makeFormula scopeRDFS "a18"
-    "rdfs:member        rdfs:range  rdfs:Resource ."
-
-rdfsa19 :: RDFFormula-rdfsa19 = makeFormula scopeRDFS "a19"
-    "rdf:first          rdfs:domain rdf:List ."
-
-rdfsa20 :: RDFFormula-rdfsa20 = makeFormula scopeRDFS "a20"
-    "rdf:first          rdfs:range  rdfs:Resource ."
-
-rdfsa21 :: RDFFormula-rdfsa21 = makeFormula scopeRDFS "a21"
-    "rdf:rest           rdfs:domain rdf:List ."
-
-rdfsa22 :: RDFFormula-rdfsa22 = makeFormula scopeRDFS "a22"
-    "rdf:rest           rdfs:range  rdf:List ."
-
-rdfsa23 :: RDFFormula-rdfsa23 = makeFormula scopeRDFS "a23"
-    "rdfs:seeAlso       rdfs:domain rdfs:Resource ."
-
-rdfsa24 :: RDFFormula-rdfsa24 = makeFormula scopeRDFS "a24"
-    "rdfs:seeAlso       rdfs:range  rdfs:Resource ."
-
-rdfsa25 :: RDFFormula-rdfsa25 = makeFormula scopeRDFS "a25"
-    "rdfs:isDefinedBy   rdfs:domain rdfs:Resource ."
-
-rdfsa26 :: RDFFormula-rdfsa26 = makeFormula scopeRDFS "a26"
-    "rdfs:isDefinedBy   rdfs:range  rdfs:Resource ."
-
-rdfsa27 :: RDFFormula-rdfsa27 = makeFormula scopeRDFS "a27"
-    "rdfs:isDefinedBy   rdfs:subPropertyOf rdfs:seeAlso ."
-
-rdfsa28 :: RDFFormula-rdfsa28 = makeFormula scopeRDFS "a28"
-    "rdfs:comment       rdfs:domain rdfs:Resource ."
-
-rdfsa29 :: RDFFormula-rdfsa29 = makeFormula scopeRDFS "a29"
-    "rdfs:comment       rdfs:range  rdfs:Literal ."
-
-rdfsa30 :: RDFFormula-rdfsa30 = makeFormula scopeRDFS "a30"
-    "rdfs:label         rdfs:domain rdfs:Resource ."
-
-rdfsa31 :: RDFFormula-rdfsa31 = makeFormula scopeRDFS "a31"
-    "rdfs:label         rdfs:range  rdfs:Literal ."
-
-rdfsa32 :: RDFFormula-rdfsa32 = makeFormula scopeRDFS "a32"
-    "rdf:value          rdfs:domain rdfs:Resource ."
-
-rdfsa33 :: RDFFormula-rdfsa33 = makeFormula scopeRDFS "a33"
-    "rdf:value          rdfs:range  rdfs:Resource ."
-
-rdfsa34 :: RDFFormula-rdfsa34 = makeFormula scopeRDFS "a34"
-    "rdf:Alt            rdfs:subClassOf    rdfs:Container ."
-
-rdfsa35 :: RDFFormula-rdfsa35 = makeFormula scopeRDFS "a35"
-    "rdf:Bag            rdfs:subClassOf    rdfs:Container ."
-
-rdfsa36 :: RDFFormula-rdfsa36 = makeFormula scopeRDFS "a36"
-    "rdf:Seq            rdfs:subClassOf    rdfs:Container ."
-
-rdfsa37 :: RDFFormula-rdfsa37 = makeFormula scopeRDFS "a37"
-    "rdfs:ContainerMembershipProperty rdfs:subClassOf rdf:Property ."
-
-rdfsa38 :: RDFFormula-rdfsa38 = makeFormula scopeRDFS "a38"
-    "rdf:XMLLiteral     rdf:type           rdfs:Datatype ."
-
-rdfsa39 :: RDFFormula-rdfsa39 = makeFormula scopeRDFS "a39"
-    "rdf:XMLLiteral     rdfs:subClassOf    rdfs:Literal ."
-
-rdfsa40 :: RDFFormula-rdfsa40 = makeFormula scopeRDFS "a40"
-    "rdfs:Datatype      rdfs:subClassOf    rdfs:Class ."
-
-axiomsRDFS :: [RDFFormula]-axiomsRDFS =
-    [          rdfsa01, rdfsa02, rdfsa03, rdfsa04
-    , rdfsa05, rdfsa06, rdfsa07, rdfsa08, rdfsa09
-    , rdfsa10, rdfsa11, rdfsa12, rdfsa13, rdfsa14
-    , rdfsa15, rdfsa16, rdfsa17, rdfsa18, rdfsa19
-    , rdfsa20, rdfsa21, rdfsa22, rdfsa23, rdfsa24
-    , rdfsa25, rdfsa26, rdfsa27, rdfsa28, rdfsa29
-    , rdfsa30, rdfsa31, rdfsa32, rdfsa33, rdfsa34
-    , rdfsa35, rdfsa36, rdfsa37, rdfsa38, rdfsa39
-    , rdfsa40
-    ]
-
-------------------------------------------------------------
---  Define RDFS rules
-------------------------------------------------------------
-
-{-
-rdfr2 = makeN3ClosureRule scopeRDF "r2"
-            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
-            "?b rdf:type rdf:XMLLiteral ."
-            (makeVarFilterModify $ isXMLLit "?l")
--}
-
---  RDFS entailment rules (from RDF semantics document section 7.2)
---
---  (Note, statements with property rdf:_allocatedTo are introduced to
---  track bnodes introduced according to rule rdflf.)
---
-rdfsr1 = makeN3ClosureRule scopeRDFS "r1"
-            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
-            "?b rdf:type rdfs:Literal ."
-            (makeVarFilterModify $ isUntypedLitV "?l" )
-
-rdfsr2 = makeN3ClosureSimpleRule scopeRDFS "r2"
-            "?x ?a ?y . ?a rdfs:domain ?z ."
-            "?x rdf:type ?z ."
-
-rdfsr3 = makeN3ClosureRule scopeRDFS "r3"
-            "?u ?a ?v . ?a rdfs:range ?z ."
-            "?v rdf:type ?z ."
-            (makeVarFilterModify $ requireAny [isUriRefV "?v",isBlankV "?v"])
-
-rdfsr4a = makeN3ClosureSimpleRule scopeRDFS "r4a"
-            "?x ?a ?y ."
-            "?x rdf:type rdfs:Resource ."
-
-rdfsr4b = makeN3ClosureRule scopeRDFS "r4b"
-            "?x ?a ?u ."
-            "?u rdf:type rdfs:Resource ."
-            (makeVarFilterModify $ requireAny [isUriRefV "?u",isBlankV "?u"])
-
-rdfsr5  = makeN3ClosureSimpleRule scopeRDFS "r5"
-            "?a rdfs:subPropertyOf ?b . ?b rdfs:subPropertyOf ?c ."
-            "?a rdfs:subPropertyOf ?c ."
-
-rdfsr6  = makeN3ClosureSimpleRule scopeRDFS "r6"
-            "?x rdf:type rdf:Property ."
-            "?x rdfs:subPropertyOf ?x ."
-
-rdfsr7  = makeN3ClosureSimpleRule scopeRDFS "r7"
-            "?x ?a ?y . ?a rdfs:subPropertyOf ?b ."
-            "?x ?b ?y ."
-
-rdfsr8  = makeN3ClosureSimpleRule scopeRDFS "r8"
-            "?x rdf:type rdfs:Class ."
-            "?x rdfs:subClassOf rdfs:Resource ."
-
-rdfsr9  = makeN3ClosureSimpleRule scopeRDFS "r9"
-            "?x rdfs:subClassOf ?y . ?a rdf:type ?x ."
-            "?a rdf:type ?y ."
-
-rdfsr10 = makeN3ClosureSimpleRule scopeRDFS "r10"
-            "?x rdf:type rdfs:Class ."
-            "?x rdfs:subClassOf ?x ."
-
-rdfsr11 = makeN3ClosureSimpleRule scopeRDFS "r11"
-            "?x rdfs:subClassOf ?y . ?y rdfs:subClassOf ?z ."
-            "?x rdfs:subClassOf ?z ."
-
-rdfsr12 = makeN3ClosureSimpleRule scopeRDFS "r12"
-            "?x rdf:type rdfs:ContainerMembershipProperty ."
-            "?x rdfs:subPropertyOf rdfs:member ."
-
-rdfsr13 = makeN3ClosureSimpleRule scopeRDFS "r13"
-            "?x rdf:type rdfs:Datatype ."
-            "?x rdfs:subClassOf rdfs:Literal ."
-
---  These are valid only under an extensional strengthening of RDFS,
---  discussed in section 7.3.1 of the RDF semantics specification:
-
-rdfsrext1 = makeN3ClosureSimpleRule scopeRDFS "ext1"
-            "?x rdfs:domain ?y . ?y rdfs:subClassOf ?z ."
-            "?x rdfs:domain ?z ."
-
-rdfsrext2 = makeN3ClosureSimpleRule scopeRDFS "ext2"
-            "?x rdfs:range ?y . ?y rdfs:subClassOf ?z ."
-            "?x rdfs:range ?z ."
-
-rdfsrext3 = makeN3ClosureSimpleRule scopeRDFS "ext3"
-            "?x rdfs:domain ?y . ?z rdfs:subPropertyOf ?x ."
-            "?z rdfs:domain ?y ."
-
-rdfsrext4 = makeN3ClosureSimpleRule scopeRDFS "ext4"
-            "?x rdfs:range ?y . ?z rdfs:subPropertyOf ?x ."
-            "?z rdfs:range ?y ."
-
-rdfsrext5 = makeN3ClosureSimpleRule scopeRDFS "ext5"
-            "rdf:type rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
-            "rdfs:Resource rdfs:subClassOf ?y ."
-
-rdfsrext6 = makeN3ClosureSimpleRule scopeRDFS "rext6"
-            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
-            "rdfs:Class rdfs:subClassOf ?y ."
-
-rdfsrext7 = makeN3ClosureSimpleRule scopeRDFS "rext7"
-            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
-            "rdfs:Property rdfs:subClassOf ?y ."
-
-rdfsrext8 = makeN3ClosureSimpleRule scopeRDFS "rext8"
-            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."
-            "rdfs:Class rdfs:subClassOf ?y ."
-
-rdfsrext9 = makeN3ClosureSimpleRule scopeRDFS "rext9"
-            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."
-            "rdfs:Property rdfs:subClassOf ?y ."
-
-
---  Container property axioms (from RDF semantics document section 4.1)
---
---  (Using here an inference rule with a filter in place of an axiom schema)
---
---  This is a restricted form of the given axioms, in that the axioms
---  are asserted only for container membership terms that appear in
---  the graph.
---
---  (This may be very inefficient for forward chaining when dealing with
---  large graphs:  may need to look at query logic to see if the search for
---  container membership properties can be optimized.  This may call for a
---  custom inference rule.)
---
-rdfscp11 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?c ?y . "
-            "?c rdf:type rdfs:ContainerMembershipProperty ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp12 = makeN3ClosureRule scopeRDFS "cp1"
-            "?c  ?p ?y . "
-            "?c rdf:type rdfs:ContainerMembershipProperty ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp13 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?p ?c . "
-            "?c rdf:type rdfs:ContainerMembershipProperty ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp21 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?c ?y . "
-            "?c rdfs:domain rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp22 = makeN3ClosureRule scopeRDFS "cp1"
-            "?c  ?p ?y . "
-            "?c rdfs:domain rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp23 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?p ?c . "
-            "?c rdfs:domain rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp31 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?c ?y . "
-            "?c rdfs:range rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp32 = makeN3ClosureRule scopeRDFS "cp1"
-            "?c  ?p ?y . "
-            "?c rdfs:range rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
-rdfscp33 = makeN3ClosureRule scopeRDFS "cp1"
-            "?x  ?p ?c . "
-            "?c rdfs:range rdfs:Resource ."
-            (makeVarFilterModify $ isMemberPropV "?c")
-
---  Collect RDFS rules
---
-rulesRDFS =
-    [ rdfsr1,    rdfsr2,    rdfsr3,    rdfsr4a,   rdfsr4b
-    , rdfsr5,    rdfsr6,    rdfsr7,    rdfsr8,    rdfsr9
-    , rdfsr10,   rdfsr11,   rdfsr12,   rdfsr13
-    , rdfscp11,   rdfscp12,   rdfscp13
-    , rdfscp21,   rdfscp22,   rdfscp23
-    , rdfscp31,   rdfscp32,   rdfscp33
-    ]
-
---  Define ruleset for RDFS inference
-
-rulesetRDFS = makeRuleset scopeRDFS axiomsRDFS rulesRDFS
-
-------------------------------------------------------------
---  Define RDFD (datatyping) axioms
-------------------------------------------------------------
-
--- scopeRDFD = Namespace "rdfd" "http://id.ninebynine.org/2003/Ruleset/rdfd#"
-
-axiomsRDFD =
-    [
-    ]
-
-------------------------------------------------------------
---  Define RDFD (datatyping) axioms
-------------------------------------------------------------
-
---  RDFD closure rules from semantics document, section 7.4
-
---  Infer type of datatyped literal
---
-rdfdr1 = makeN3ClosureRule scopeRDFD "r1"
-            "?d rdf:type rdfs:Datatype . ?a ?p ?l . ?b rdf:_allocatedTo ?l . "
-            "?b rdf:type ?d ."
-            (makeVarFilterModify $ isDatatypedV "?d" "?l")
-
---  Equivalent literals with same datatype:
---  (generate canonical form, or operate in proof mode only)
---
-rdfdr2 = makeN3ClosureRule scopeRDFD "r2"
-            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."
-            "?a ?p ?t ."
-            (valueSame "?s" "?d" "?t" "?d")
-
-{- Note that valueSame does datatype check.  Otherwise use:
-rdfdr2 = makeN3ClosureModifyRule scopeRDFD "r2"
-            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."
-            "?a ?p ?t ."
-            (makeVarFilterModify $ isDatatypedV "?d" "?s")
-            (valueSame "?s" "?d" "?t" "?d")
--}
-
---  Equivalent literals with different datatypes:
---  (generate canonical form, or operate in proof mode only)
---
-rdfdr3 = makeN3ClosureModifyRule scopeRDFD "r3"
-            ( "?d rdf:type rdfs:Datatype . ?e rdf:type rdfs:Datatype . " ++
-              "?a ?p ?s ." )
-            "?a ?p ?t ."
-            (makeVarFilterModify $ isDatatypedV "?s" "?d")
-            (valueSame "?s" "?d" "?t" "?e")
-
---  Collect RDFD rules
---
-rulesRDFD =
-    [ rdfdr1, rdfdr2, rdfdr3
-    ]
-
---  Define ruleset for RDFD inference
---
-rulesetRDFD = makeRuleset scopeRDFD axiomsRDFD rulesRDFD
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFProofContext.hs,v $
--- $Author: graham $
--- $Revision: 1.13 $
--- $Log: RDFProofContext.hs,v $
--- Revision 1.13  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.12  2003/12/20 12:00:14  graham
--- Introduced new TraceHelpers module for Hugs-2003 compatibility.
---
--- Revision 1.11  2003/12/19 21:01:25  graham
--- Change Debug.Trace import (from Hugs.Trace)
---
--- Revision 1.10  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.9  2003/12/16 07:05:37  graham
--- Working on updated RDFProofContext
---
--- Revision 1.8  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.7  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.6  2003/12/01 18:51:38  graham
--- Described syntax for Swish script.
--- Created Swish scripting test data.
--- Edited export/import lists in Swish main program modules.
---
--- Revision 1.5  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.4  2003/10/22 16:18:37  graham
--- Move common namespace definitions into Namespace module
--- (May later move these into separate modules.)
---
--- Revision 1.3  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.2  2003/10/09 13:58:59  graham
--- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
--- of using just QueryBindingModifier.
---
--- Revision 1.1  2003/10/02 13:39:41  graham
--- RDF axioms and rules defined as Rulesets, and moved out of module
--- RDFProofCheck into RDFProorfContext, with corresponding test cases
--- moved to module RDFProorfContextTest.
---
− Swish/HaskellRDF/RDFProofContextTest.hs 
@@ -1,672 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFProofContextTest.hs,v 1.14 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFProofContextTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains RDF proof-checking test cases based on the RDF
---  semantics specifications, as capured in module RDFProofContext.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUTmodule Swish.HaskellRDF.RDFProofContextTest
 where
-
-import Swish.HaskellRDF.BuiltInMap
-    ( rdfRulesetMap, allRulesets )
-
-import Swish.HaskellRDF.RDFProofContext
-    ( rulesetRDF
-    , rulesetRDFS
-    , rulesetRDFD )
-
-import Swish.HaskellRDF.RDFProof
-    ( RDFProof, RDFProofStep
-    , makeRDFProof, makeRDFProofStep
-    , makeRdfInstanceEntailmentRule
-    , makeRdfSubgraphEntailmentRule
-    , makeRdfSimpleEntailmentRule )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
-    , nullRDFFormula
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    , makeNodeAllocTo )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph )
-
-import Swish.HaskellRDF.RDFGraphShowM()
-
-import Swish.HaskellRDF.Proof
-    ( Proof(..), Step(..)
-    , checkProof, checkStep, showProof, showsProof, showsFormula
-    , explainProof)
-
-import Swish.HaskellRDF.Ruleset
-    ( getContextAxiom, getContextRule )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..)
-    , nullScope, nullFormula, nullRule )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..), ScopedName(..) )
-
-import Swish.HaskellUtils.LookupMap
-    ( mapFindMaybe )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceXSD
-    , namespaceXsdType
-    , scopeRDF
-    , scopeRDFS
-    , scopeRDFD
-    )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    , putStr )
-
-import Data.Maybe
-    ( isJust, isNothing, fromJust, fromMaybe )
-
---  misc helpers
-
-test :: String -> Bool -> Test
-test lab tst = TestCase $ assertBool lab tst
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab e a = TestCase $ assertEqual lab e a
-
-testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test
-testJe lab e a = TestList
-    [ TestCase $ assertBool  lab (isJust a)
-    , TestCase $ assertEqual lab e (fromJust a)
-    ]
-
-testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test
-testJl lab e a = TestList
-    [ TestCase $ assertBool  lab   (isJust a)
-    , TestCase $ assertEqual lab e (length (fromJust a))
-    ]
-
-testNo :: (Eq a, Show a) => String -> [[a]] -> Test
-testNo lab a =
-    TestCase $ assertBool  lab   (null a)
-
-testGr :: String -> RDFGraph -> [RDFGraph] -> Test
-testGr lab eg a = TestCase $ assertBool lab (eg `elem` a)
-
--- testProof "rdfProof01" True rdfProof01
-testProof :: String -> Bool -> RDFProof -> Test
-testProof lab valid proof = TestList
-    [ TestCase $ assertEqual lab valid (checkProof proof)
-    , TestCase $ assertBool  (lab++": "++ex) (valid == (isNothing $ expl))
-    ]
-    where
-        expl = explainProof proof
-        ex   = fromMaybe "(Proof OK)" expl
-
--- testProofStep "rdfStep01" True [rules] [antes] rdfStep01
-testProofStep ::
-    String -> Bool -> [RDFRule] -> [RDFGraph] -> Step RDFGraph
-    -> Test
-testProofStep lab valid rules antes step =
-    TestCase $ assertEqual lab valid (checkStep rules antes step)
-
---  Various support methods
-
-makeFormula :: Namespace -> String -> String -> RDFFormula
-makeFormula scope local gr =
-    makeRDFFormula scope local (prefix++gr)
-
-getRule :: String -> RDFRule
-getRule nam = getContextRule (makeSName nam) nullRule $
-    rdfdContext++[rulesetXsdInt,rulesetXsdStr]
-
-getAxiom :: String -> RDFFormula
-getAxiom nam = getContextAxiom (makeSName nam) nullRDFFormula rdfdContext
-
-makeSName :: String -> ScopedName
-makeSName nam = ScopedName ns loc
-    where
-        (pre,_:loc) = break (==':') nam
-        ns = case pre of
-            "rs_rdf"  -> scopeRDF
-            "rs_rdfs" -> scopeRDFS
-            "rs_rdfd" -> scopeRDFD
-            "xsd_integer" -> (namespaceXsdType "integer")
-            "xsd_string"  -> (namespaceXsdType "string")
-            otherwise -> error ("makeSName: Unrecognized prefix in rule name: "++nam)
-
---  Common definitions
-
-prefix =
-    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" ++
-    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++
-    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
-    "@prefix xsd:  <" ++ nsURI namespaceXSD  ++ "> . \n" ++
-    "@prefix ex:   <http://example.org/> . \n" ++
-    " \n"
-
-scopeex   = Namespace "ex"   "http://id.ninebynine.org/wip/2003/RDFProofCheck#"
-
-rdfContext  = [ rulesetRDF ]
-
-rdfsContext = [ rulesetRDF, rulesetRDFS ]
-
-rdfdContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD ]
-
-xsdintContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdInt ]
-
-xsdstrContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdStr ]
-
-Just rulesetXsdInt = mapFindMaybe (namespaceXsdType "integer") rdfRulesetMap
-
-Just rulesetXsdStr = mapFindMaybe (namespaceXsdType "string") rdfRulesetMap
-
-------------------------
---  RDF/S rule tests
-------------------------
---
---  These tests aim to exercise the specific closure rule constructs
---  that are used by the RDF/S rules.  They have been prepared as a
---  regression test for a refactoring of the variable binding
---  filtering and modification logic.
-
---  Simple rule test - forward and backward chaining
---
---  rdfr1 = "?x ?a ?y ." => "?a rdf:type rdf:Property ."
---
-rdfr1  = getRule "rs_rdf:r1"
-ant01  = formExpr $ makeFormula scopeex "ant01" $
-    "ex:s ex:p1 ex:o1 ; ex:p2 ex:o2 ."
-con01  = formExpr $ makeFormula scopeex "con01" $
-    "ex:p1 rdf:type rdf:Property ." ++
-    "ex:p2 rdf:type rdf:Property ."
-bwd01  = formExpr $ makeFormula scopeex "bwd01a" $
-    "_:s1 ex:p1 _:o1 . " ++
-    "_:s2 ex:p2 _:o2 . "
-testRule01a = testEq "testRule01a" "rs_rdf:r1" (show $ ruleName rdfr1)
-testRule01b = testEq "testRule01b" [con01]     (fwdApply rdfr1 [ant01])
-testRule01c = testEq "testRule01c" [[bwd01]]   (bwdApply rdfr1 con01)
-testRule01d = test   "testRule01d" (checkInference rdfr1 [ant01] con01)
-testRule01e = test   "testRule01e" (checkInference rdfr1 [bwd01] con01)
-
---  Simple rule test - no match forward or backward
---
---  rdfsr2 = "?x ?a ?y . ?a rdfs:domain ?z ." => "?x rdf:type ?z ."
---
-rdfsr2 = getRule "rs_rdfs:r2"
-ant02  = formExpr $ makeFormula scopeex "ant02" $
-    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."
-con02  = formExpr $ makeFormula scopeex "con02" $
-    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."
-testRule02a = testEq "testRule02a" "rs_rdfs:r2" (show $ ruleName rdfsr2)
-testRule02b = testEq "testRule02b" []           (fwdApply rdfsr2 [ant02])
-testRule02c = testEq "testRule02c" []           (bwdApply rdfsr2 con02)
-testRule02d = testEq "testRule02d" False (checkInference rdfsr2 [ant02] con02)
-
---  Rule with literal test and "allocateTo":
---  match forward, but not backward
---
---  This is a two-part rule: (a) apply rdflg, (b) apply rdfr2
---
---  rdflg = "?x ?a ?l . " => "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."
---  where:
---          (isLiteral "?l")
---          (allocateTo "?b" "?l")
---
---  rdfr2 = "?x ?a ?l . ?b rdf:_allocatedTo ?l . "
---          => "?b rdf:type rdf:XMLLiteral ."
---  where:
---          (isXMLLit "?l")
---
-rdflg  = getRule "rs_rdf:lg"
-rdfr2  = getRule "rs_rdf:r2"
-ant03  = formExpr $ makeFormula scopeex "ant03" $
-    "ex:s ex:p1  \"lit1\"^^rdf:XMLLiteral ; " ++
-    "     ex:p2a \"lit2\"^^rdf:XMLLiteral ; " ++
-    "     ex:p2b \"lit2\"^^rdf:XMLLiteral ."
-con03lg  = formExpr $ makeFormula scopeex "con03" $
-    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++
-    "_:l1 rdf:_allocatedTo \"lit1\"^^rdf:XMLLiteral ." ++
-    "_:l2 rdf:_allocatedTo \"lit2\"^^rdf:XMLLiteral ."
-con03r2  = formExpr $ makeFormula scopeex "con03" $
-    "_:l1 rdf:type rdf:XMLLiteral ." ++
-    "_:l2 rdf:type rdf:XMLLiteral ."
-
-testRule03a = testEq "testRule03a" "rs_rdf:lg" (show $ ruleName rdflg)
-testRule03b = testEq "testRule03b" "rs_rdf:r2" (show $ ruleName rdfr2)
-testRule03c = testEq "testRule03c" [con03lg]   (fwdApply rdflg [ant03])
-testRule03d = testEq "testRule03d" []          (bwdApply rdflg con03lg)
-testRule03e = test   "testRule03e" (checkInference rdflg [ant03] con03lg)
-testRule03f = testEq "testRule03f" [con03r2]   (fwdApply rdfr2 [con03lg])
-testRule03g = testEq "testRule03g" []          (bwdApply rdfr2 con03r2)
-testRule03h = test   "testRule03h" (checkInference rdfr2 [con03lg] con03r2)
-
---  Rule with member property test, match forwards and backwards
---  rdfcp1 = "?x  ?c ?y . " => "?c rdf:type rdf:Property ."
---  where:
---          (isMemberProp "?c")
---
-rdfcp  = getRule "rs_rdf:cp1"
-ant04  = formExpr $ makeFormula scopeex "ant04" $
-    "ex:s rdf:_123 ex:o1 ; " ++
-    "     rdf:_2   ex:o2 . "
-con04  = formExpr $ makeFormula scopeex "con04" $
-    "rdf:_123 rdf:type rdf:Property ." ++
-    "rdf:_2   rdf:type rdf:Property ."
-bwd04  = formExpr $ makeFormula scopeex "bwd04a" $
-    "_:s1 rdf:_123 _:o1 . " ++
-    "_:s2 rdf:_2   _:o2 . "
-testRule04a = testEq "testRule04a" "rs_rdf:cp1" (show $ ruleName rdfcp)
-testRule04b = testEq "testRule04b" [con04]      (fwdApply rdfcp [ant04])
-testRule04c = testEq "testRule04c" [[bwd04]]    (bwdApply rdfcp con04)
-testRule04d = test   "testRule04d" (checkInference rdfcp [ant04] con04)
-testRule04e = test   "testRule01e" (checkInference rdfcp [bwd04] con04)
-
---  Rule with disjunction test, match forwards and backwards
---
---  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."
---  where:
---          (requireAny [isUriRef "?u",isBlank "?u"])
---
-rdfsr3 = getRule "rs_rdfs:r3"
-ant05  = formExpr $ makeFormula scopeex "ant05" $
-    "ex:s ex:p1 ex:o1 ; "        ++
-    "     ex:p2 _:o2  . "        ++
-    "ex:p1 rdfs:range ex:pr1 . " ++
-    "ex:p2 rdfs:range ex:pr2 . "
-con05  = formExpr $ makeFormula scopeex "con05" $
-    "ex:o1 rdf:type ex:pr1 ." ++
-    "_:o2  rdf:type ex:pr2 ."
-bwd05  = formExpr $ makeFormula scopeex "bwd05a" $
-    "_:s1 _:p1 ex:o1 . "        ++
-    "_:s2 _:p2 _:o2  . "        ++
-    "_:p1 rdfs:range ex:pr1 . " ++
-    "_:p2 rdfs:range ex:pr2 . "
-testRule05a = testEq "testRule05a" "rs_rdfs:r3" (show $ ruleName rdfsr3)
-testRule05b = testEq "testRule05b" [con05]      (fwdApply rdfsr3 [ant05])
-testRule05c = testEq "testRule05c" [[bwd05]]    (bwdApply rdfsr3 con05)
-testRule05d = test   "testRule05d" (checkInference rdfsr3 [ant05] con05)
-testRule05e = test   "testRule01e" (checkInference rdfsr3 [bwd05] con05)
-
---  Rule with disjunction test, fail forwards
---
---  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."
---  where:
---          (requireAny [isUriRef "?u",isBlank "?u"])
---
-ant06  = formExpr $ makeFormula scopeex "ant06" $
-    "ex:s ex:p1 \"lit1\" . "     ++
-    "ex:p1 rdfs:range ex:pr1 . "
-con06  = formExpr $ makeFormula scopeex "con06" $
-    "_:o1  rdf:type ex:pr1 ."
-bwd06  = formExpr $ makeFormula scopeex "bwd06a" $
-    "_:s1 _:p1 _:o1 . "      ++
-    "_:p1 rdfs:range ex:pr1 . "
-chk06  = formExpr $ makeFormula scopeex "bwd06a" $
-    "_:s1 _:p1 \"lit1\" . "      ++
-    "_:p1 rdfs:range ex:pr1 . "
-testRule06a = testEq "testRule06a" "rs_rdfs:r3" (show $ ruleName rdfsr3)
-testRule06b = testEq "testRule06b" []           (fwdApply rdfsr3 [ant06])
-testRule06c = testEq "testRule06c" [[bwd06]]    (bwdApply rdfsr3 con06)
-testRule06d = testEq "testRule06d" False (checkInference rdfsr3 [ant06] con06)
-testRule06e = testEq "testRule06e" True  (checkInference rdfsr3 [bwd06] con06)
-testRule06f = testEq "testRule06e" False (checkInference rdfsr3 [chk06] con06)
-
---  Collected rule tests
-
-testRules = TestList
-    [ testRule01a, testRule01b, testRule01c, testRule01d, testRule01e
-    , testRule02a, testRule02b, testRule02c, testRule02d
-    , testRule03a, testRule03b, testRule03c, testRule03d, testRule03e
-    , testRule03f, testRule03g, testRule03h
-    , testRule04a, testRule04b, testRule04c, testRule04d, testRule04e
-    , testRule05a, testRule05b, testRule05c, testRule05d, testRule05e
-    , testRule06a, testRule06b, testRule06c, testRule06d, testRule06e
-    , testRule06f
-    ]
-
-------------------------
---  Complete proof tests
-------------------------
---
---  These are a few tests of complete RDF proof chains based on the
---  RDF semantic rules.
-
-
---  RDF entailment proof checks
-
-rdfBase01  = makeFormula scopeex "rdfBase01" "ex:s ex:p ex:o ."
-rdfGoal01  = makeFormula scopeex "rdfGoal01" "ex:p rdf:type rdf:Property ."
-rdfStep01a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase01] rdfGoal01
-rdfProof01 = makeRDFProof rdfsContext rdfBase01 rdfGoal01
-                [ rdfStep01a ]
-
-rdfBase02  = makeFormula scopeex "rdfBase02" $
-                "ex:s ex:p \"l1\"^^rdf:XMLLiteral ."
-rdfCon02a  = makeFormula scopeex "rdfStep02a" $
-                "ex:s ex:p _:lll . "             ++
-                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "
-rdfGoal02  = makeFormula scopeex "rdfGoal02" $
-                "_:lll rdf:type rdf:XMLLiteral . "
-rdfStep02a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase02] rdfCon02a
-rdfStep02b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon02a] rdfGoal02
-rdfProof02 = makeRDFProof rdfsContext rdfBase02 rdfGoal02
-                [ rdfStep02a, rdfStep02b ]
-
-rdfBase03  = makeFormula scopeex "rdfBase03" $
-                "ex:s ex:p ex:o ."
-rdfCon03a  = makeFormula scopeex "rdfStep03a" $
-                "ex:s ex:p _:lll . "             ++
-                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "
-rdfGoal03  = makeFormula scopeex "rdfGoal03" $
-                "_:lll rdf:type rdf:XMLLiteral . "
-rdfStep03a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase03] rdfCon03a
-rdfStep03b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon03a] rdfGoal03
-rdfProof03 = makeRDFProof rdfsContext rdfBase03 rdfGoal03
-                [ rdfStep03a, rdfStep03b ]
-
-rdfBase04  = makeFormula scopeex "rdfBase04" "ex:s ex:p ex:o ."
-rdfGoal04  = makeFormula scopeex "rdfGoal04" "_:s  ex:p _:o ."
-rdfStep04a = makeRDFProofStep (getRule "rs_rdf:se") [rdfBase04] rdfGoal04
-rdfProof04 = makeRDFProof rdfsContext rdfBase04 rdfGoal04
-                [ rdfStep04a ]
-
-rdfBase05  = makeFormula scopeex "rdfBase05" $
-                "ex:s ex:p rdf:nil ."
-rdfStep05a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase05]  rdfCons05a
-rdfCons05a = makeFormula scopeex "rdfCons05a" $
-                "ex:p  rdf:type rdf:Property ."
-rdfStep05b = makeRDFProofStep (getRule "rs_rdf:se")
-                [rdfBase05,rdfCons05a,(getAxiom "rs_rdf:a8")] rdfGoal05
-rdfGoal05  = makeFormula scopeex "rdfGoal05" $
-                "ex:s _:p _:n ."               ++
-                "_:p  rdf:type rdf:Property ." ++
-                "_:n  rdf:type rdf:List ."
-rdfProof05 = makeRDFProof rdfsContext rdfBase05 rdfGoal05
-                [ rdfStep05a, rdfStep05b ]
-
---  Swap rdfProof05 proof steps:
-rdfProof06 = makeRDFProof rdfsContext rdfBase05 rdfGoal05
-                [ rdfStep05b, rdfStep05a ]
-
---  Proof using rdfsr1 and rdfsub
---
---    ex:s1 ex:p1 "lll"
---    ex:s2 ex:p2 "lll"
---  =>
---    ex:s1 ex:p1 _:l
---    ex:s2 ex:p2 _:l
---    _:l   rdf:type rdfs:Literal
-
-rdfBase07  = makeFormula scopeex "rdfBase07" $
-                "ex:s1 ex:p1 \"lll\" ." ++
-                "ex:s2 ex:p2 \"lll\" ." ++
-                "ex:s3 ex:p3 \"mmm\" ."
-rdfStep07a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase07]  rdfCons07a
-rdfCons07a = makeFormula scopeex "rdfCons07a" $
-                "ex:s1 ex:p1 _:l ."              ++
-                "ex:s2 ex:p2 _:l ."              ++
-                "_:l rdf:_allocatedTo \"lll\" ." ++
-                "ex:s3 ex:p3 _:m ."              ++
-                "_:m rdf:_allocatedTo \"mmm\" ."
-rdfStep07b = makeRDFProofStep (getRule "rs_rdfs:r1") [rdfCons07a]  rdfCons07b
-rdfCons07b = makeFormula scopeex "rdfCons07a" $
-                "_:l rdf:type rdfs:Literal ." ++
-                "_:m rdf:type rdfs:Literal ."
-rdfStep07c = makeRDFProofStep (getRule "rs_rdf:sub")
-                [rdfCons07a,rdfCons07b] rdfGoal07
-rdfGoal07  = makeFormula scopeex "rdfGoal07" $
-                "ex:s1 ex:p1 _:l ."           ++
-                "ex:s2 ex:p2 _:l ."           ++
-                "_:l rdf:type rdfs:Literal ."
-rdfProof07 = makeRDFProof rdfsContext rdfBase07 rdfGoal07
-                [ rdfStep07a, rdfStep07b, rdfStep07c ]
-
---  Proof of:
---    rdf:_123 rdfs:supPropertyOf rdfs:member
-
-rdfBase08  = makeFormula scopeex "rdfBase08" $
-                "ex:s1 rdf:_123 ex:o ."
-rdfStep08a = makeRDFProofStep (getRule "rs_rdfs:cp1") [rdfBase08]  rdfCons08a
-rdfCons08a = makeFormula scopeex "rdfCons08a" $
-                "rdf:_123 rdf:type rdfs:ContainerMembershipProperty ."
-rdfStep08b = makeRDFProofStep (getRule "rs_rdfs:r12")  [rdfCons08a]  rdfGoal08
-rdfGoal08  = makeFormula scopeex "rdfCons08b" $
-                "rdf:_123 rdfs:subPropertyOf rdfs:member ."
-rdfProof08 = makeRDFProof rdfsContext rdfBase08 rdfGoal08
-                [ rdfStep08a, rdfStep08b ]
-
-
---  Proof of:
---    ex:s ex:p "010"^^xsd:Integer .
---  =>
---    ex:s ex:p "10"^^xsd:Integer .
---    ex:s ex:p _:b
---    _:b rdf:type xsd:integer .
-
-rdfAxiomIntDt = getContextAxiom
-                    (ScopedName (namespaceXsdType "integer") "dt")
-                    nullFormula
-                    allRulesets
-
-rdfAxiom09 = testEq "rdfAxiom09" "xsd_integer:dt" $
-                show (formName rdfAxiomIntDt)
-
-rdfBase09  = makeFormula scopeex "rdfBase09" $
-                "ex:s ex:p \"010\"^^xsd:integer ."
-rdfStep09a = makeRDFProofStep (getRule "rs_rdfd:r2")
-                [rdfAxiomIntDt,rdfBase09]  rdfCons09a
-rdfCons09a = makeFormula scopeex "rdfCons09a" $
-                "ex:s ex:p \"10\"^^xsd:integer ."
-rdfStep09b = makeRDFProofStep (getRule "rs_rdf:lg")
-                [rdfCons09a]  rdfCons09b
-rdfCons09b = makeFormula scopeex "rdfCons09b" $
-                "ex:s ex:p _:l ." ++
-                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ."
-rdfStep09c = makeRDFProofStep (getRule "rs_rdfd:r1")
-                [rdfAxiomIntDt,rdfCons09a,rdfCons09b]  rdfCons09c
-rdfCons09c = makeFormula scopeex "rdfCons09c" $
-                "_:l rdf:type xsd:integer ."
-rdfStep09d = makeRDFProofStep (getRule "rs_rdf:sub")
-                [rdfCons09a,rdfCons09b,rdfCons09c]  rdfGoal09
-rdfGoal09  = makeFormula scopeex "rdfGoal09" $
-                "ex:s ex:p  \"10\"^^xsd:integer ."           ++
-                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." ++
-                "_:l rdf:type xsd:integer ."
-rdfProof09 = makeRDFProof xsdintContext rdfBase09 rdfGoal09
-                [ rdfStep09a, rdfStep09b, rdfStep09c, rdfStep09d ]
-
--- {- test data
-p09t1 = fwdApply (getRule "rs_rdfd:r2")
-    [(formExpr rdfAxiomIntDt),(formExpr rdfBase09)]
-p09sh = putStrLn ("\n"++showProof "\n" rdfProof09++"\n")
--- -}
-
-
---  Proof of:
---    ex:s ex:p "abc" .
---    ex:s ex:p "def"^^xsd:string .
---  =>
---    ex:s ex:p "abc"^^xsd:string .
---    ex:s ex:p "def" .
---    xsd:string rdf:type rdfs:Datatype .
-
-rdfAxiomStrDt = getContextAxiom
-                    (ScopedName (namespaceXsdType "string") "dt")
-                    nullFormula
-                    allRulesets
-
-rdfAxiom10 = testEq "rdfAxiom10" "xsd_string:dt" $
-                show (formName rdfAxiomStrDt)
-
-rdfRule10 = testEq "rdfRule10" "xsd_string:ls" $
-                show (ruleName (getRule "xsd_string:ls"))
-
-rdfBase10  = makeFormula scopeex "rdfBase10" $
-                "ex:s ex:p \"abc\" . " ++
-                "ex:s ex:p \"def\"^^xsd:string . "
-rdfStep10a = makeRDFProofStep (getRule "xsd_string:ls")
-                [rdfBase10]  rdfCons10a
-rdfCons10a = makeFormula scopeex "rdfCons10a" $
-                "ex:s ex:p \"abc\"^^xsd:string . "
-rdfStep10b = makeRDFProofStep (getRule "xsd_string:sl")
-                [rdfBase10]  rdfCons10b
-rdfCons10b = makeFormula scopeex "rdfCons10b" $
-                "ex:s ex:p \"def\" . "
-rdfStep10c = makeRDFProofStep (getRule "rs_rdf:sub")
-                [rdfCons10a,rdfCons10b,rdfAxiomStrDt] rdfGoal10
-rdfGoal10  = makeFormula scopeex "rdfGoal10" $
-                "ex:s ex:p \"abc\"^^xsd:string . " ++
-                "ex:s ex:p \"def\" . "             ++
-                "xsd:string rdf:type rdfs:Datatype . "
-rdfProof10 = makeRDFProof xsdstrContext rdfBase10 rdfGoal10
-                [ rdfStep10a, rdfStep10b, rdfStep10c ]
-
-testRdf = TestList
-    [ testProofStep "rdfStep01a" True  [(getRule "rs_rdf:r1")] [formExpr rdfBase01] rdfStep01a
-    , testProof     "rdfProof01" True  rdfProof01
-    --   Really should have support for scoped bnodes
-    , testProof     "rdfProof02" True  rdfProof02
-    , testProof     "rdfProof03" False rdfProof03
-    , testProof     "rdfProof04" True  rdfProof04
-    , testProof     "rdfProof05" True  rdfProof05
-    , testProof     "rdfProof06" False rdfProof06
-    , testProof     "rdfProof07" True  rdfProof07
-    , testProof     "rdfProof08" True  rdfProof08
-    , rdfAxiom09
-    , testProof     "rdfProof09" True  rdfProof09
-    , rdfAxiom10, rdfRule10
-    , testProof     "rdfProof10" True  rdfProof10
-    {-
-    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof01)
-    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof05)
-    -}
-    ]
-
-------------------------------------------------------------
---  Full test suite, main program,
---  and useful expressions for interactive use
-------------------------------------------------------------
-
-allTests = TestList
-  [ testRules
-  , testRdf
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-p10 = runTestTT $ TestList
-    [ rdfAxiom10
-    , rdfRule10
-    , testProof     "rdfProof10" True  rdfProof10
-    ]
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFProofContextTest.hs,v $
--- $Author: graham $
--- $Revision: 1.14 $
--- $Log: RDFProofContextTest.hs,v $
--- Revision 1.14  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.13  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.12  2003/12/20 12:53:40  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.11  2003/12/18 20:46:24  graham
--- Added xsd:string module to capture equivalence of xsd:string
--- and plain literals without a language tag
---
--- Revision 1.10  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.9  2003/12/16 07:05:37  graham
--- Working on updated RDFProofContext
---
--- Revision 1.8  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.7  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.6  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.5  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.4  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.3  2003/10/09 17:16:13  graham
--- Added test cases to exercise features of rules used to capture
--- RDF semantics.  Also added proof test case using XML literal.
---
--- Revision 1.2  2003/10/09 13:58:59  graham
--- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
--- of using just QueryBindingModifier.
---
--- Revision 1.1  2003/10/02 13:39:41  graham
--- RDF axioms and rules defined as Rulesets, and moved out of module
--- RDFProofCheck into RDFProorfContext, with corresponding test cases
--- moved to module RDFProorfContextTest.
---
− Swish/HaskellRDF/RDFProofTest.hs 
@@ -1,1080 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFProofTest.hs,v 1.21 2004/01/06 13:53:10 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFProofTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module tests the RDFproof module, which instantiates the proof
---  rule class over RDF graphs.
---
---------------------------------------------------------------------------------
-
---  WNH RIP OUTmodule Swish.HaskellRDF.RDFProofTest
 where
-
-import Swish.HaskellRDF.RDFProof
-    ( RDFProof, RDFProofStep
-    , makeRDFProof, makeRDFProofStep
-    , makeRdfInstanceEntailmentRule
-    , makeRdfSubgraphEntailmentRule
-    , makeRdfSimpleEntailmentRule
-    )
-
-import Swish.HaskellRDF.RDFQuery
-    ( rdfQueryFind, rdfQuerySubs )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBindingFilter, RDFVarBindingModify )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
-    , GraphClosure(..), makeGraphClosureRule
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    , makeN3ClosureAllocatorRule
-    , makeN3ClosureRule
-    , makeN3ClosureSimpleRule
-    , makeNodeAllocTo
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( Label(..), RDFLabel(..), NSGraph(..), RDFGraph
-    , getArcs, add, allLabels, allNodes )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..), nullVarBinding
-    , VarBindingModify(..)
-    , makeVarFilterModify
-    , varBindingId -- , varFilterDisjunction, varFilterConjunction
-    , varFilterEQ, varFilterNE
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..) )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..), ScopedName(..) )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-import Data.Maybe
-    ( isJust, fromJust )
-
---  misc helpers
-
-test :: String -> Bool -> Test
-test lab tst = TestCase $ assertBool lab tst
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab e a = TestCase $ assertEqual lab e a
-
-testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test
-testJe lab e a = TestList
-    [ TestCase $ assertBool  lab (isJust a)
-    , TestCase $ assertEqual lab e (fromJust a)
-    ]
-
-testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test
-testJl lab e a = TestList
-    [ TestCase $ assertBool  lab   (isJust a)
-    , TestCase $ assertEqual lab e (length (fromJust a))
-    ]
-
-testNo :: (Eq a, Show a) => String -> [[a]] -> Test
-testNo lab a =
-    TestCase $ assertBool  lab   (null a)
-
-testIn :: (Eq a, Show a) => String -> a -> [a] -> Test
-testIn lab eg a = TestCase $ assertBool lab (eg `elem` a)
-
---  test1:  simple query with URI, literal and blank nodes.
-
-scope1 = Namespace "scope1"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope1"
-
-prefix1 =
-    "@prefix ex: <http://example.org/> . \n" ++
-    " \n"
-
-graph1    = makeRDFGraphFromN3String graph1str
-graph1str = prefix1 ++
-    "ex:s1  ex:p  ex:o1 . \n"  ++
-    "ex:s2  ex:p  \"lit1\" . \n" ++
-    "[ ex:p ex:o3 ] . \n"
-
-query11    = makeRDFGraphFromN3String query11str
-query11str = prefix1 ++
-    "?s  ex:p  ?o . \n"
-
-result11    = makeRDFGraphFromN3String result11str
-result11str = prefix1 ++
-    "?s  ex:r  ?o . \n"
-
-result11a    = makeRDFGraphFromN3String result11astr
-result11astr = prefix1 ++
-    "ex:s1  ex:r  ex:o1    . \n" ++
-    "ex:s2  ex:r  \"lit1\" . \n" ++
-    "[ ex:r ex:o3 ]        . \n"
-
-result11b    = makeRDFGraphFromN3String result11bstr
-result11bstr = prefix1 ++
-    "ex:s1  ex:r  ex:o1    . \n"
-
-result11c    = makeRDFGraphFromN3String result11cstr
-result11cstr = prefix1 ++
-    "ex:s2  ex:r  \"lit1\" . \n"
-
-backsub11a    = makeRDFGraphFromN3String backsub11astr
-backsub11astr = prefix1 ++
-    "ex:s1  ex:p  ex:o1    . \n" ++
-    "ex:s2  ex:p  \"lit1\" . \n"
-
-backsub11b    = makeRDFGraphFromN3String backsub11bstr
-backsub11bstr = prefix1 ++
-    "ex:s2  ex:p  \"lit1\" . \n"
-
-rul11 = makeN3ClosureSimpleRule scope1 "rul11" query11str result11str
-fwd11 = fwdApply rul11 [graph1]
-testFwd11  = testEq "testFwd11" 1 (length fwd11)
-testFwd11a = testIn "testFwd11a" result11a fwd11
-bwd11      = bwdApply rul11 (add result11b result11c)
-testBwd11  = testEq "testBwd11"  1 (length (head bwd11))
-testBwd11a = testIn "testBwd11a" backsub11a (head bwd11)
-
-test1 = TestList
-    [ testFwd11
-    , testFwd11a
-    , testBwd11
-    , testBwd11a
-    ]
-
-
---  test2:  a range of more complex queries based on a
---  single relationship graph.
-
-scope2 = Namespace "scope2"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope2"
-
-prefix2 =
-    "@prefix pers: <urn:pers:> . \n"      ++
-    "@prefix rel:  <urn:rel:> . \n"       ++
-    " \n"
-
-graph2    = makeRDFGraphFromN3String graph2str
-graph2str = prefix2 ++
-    "pers:St1 rel:wife     pers:Do1 ; \n" ++
-    "         rel:daughter pers:Ma2 ; \n" ++
-    "         rel:daughter pers:An2 . \n" ++
-    "pers:Pa2 rel:wife     pers:Ma2 ; \n" ++
-    "         rel:son      pers:Gr3 ; \n" ++
-    "         rel:son      pers:La3 ; \n" ++
-    "         rel:son      pers:Si3 ; \n" ++
-    "         rel:son      pers:Al3 . \n" ++
-    "pers:Br2 rel:wife     pers:Ri2 ; \n" ++
-    "         rel:daughter pers:Ma3 ; \n" ++
-    "         rel:son      pers:Wi3 . \n" ++
-    "pers:Gr3 rel:wife     pers:Ma3 ; \n" ++
-    "         rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Rh4 . \n" ++
-    "pers:Si3 rel:wife     pers:Jo3 ; \n" ++
-    "         rel:son      pers:Ol4 ; \n" ++
-    "         rel:son      pers:Lo4 . \n" ++
-    "pers:Al3 rel:wife     pers:Su3 ; \n" ++
-    "         rel:son      pers:Ha4 ; \n" ++
-    "         rel:son      pers:El4 . \n"
-
-query21    = makeRDFGraphFromN3String query21str
-query21str = prefix2 ++
-    "?a rel:wife ?b . \n"
-
-result21    = makeRDFGraphFromN3String result21str
-result21str = prefix2 ++
-    "?b rel:husband ?a . \n"
-
-result21a    = makeRDFGraphFromN3String result21astr
-result21astr = prefix2 ++
-    "pers:Do1 rel:husband pers:St1 . \n" ++
-    "pers:Ma2 rel:husband pers:Pa2 . \n" ++
-    "pers:Ri2 rel:husband pers:Br2 . \n" ++
-    "pers:Ma3 rel:husband pers:Gr3 . \n" ++
-    "pers:Jo3 rel:husband pers:Si3 . \n" ++
-    "pers:Su3 rel:husband pers:Al3 . \n"
-
-result21b    = makeRDFGraphFromN3String result21bstr
-result21bstr = prefix2 ++
-    "pers:Do1 rel:husband pers:St1 . \n" ++
-    "pers:Ma2 rel:husband pers:Pa2 . \n"
-
-bwd21a    = makeRDFGraphFromN3String bwd21astr
-bwd21astr = prefix2 ++
-    "pers:St1 rel:wife     pers:Do1 . \n" ++
-    "pers:Pa2 rel:wife     pers:Ma2 . \n"
-
-rul21 = makeN3ClosureSimpleRule scope2 "rul21" query21str result21str
-fwd21 = fwdApply rul21 [graph2]
-testFwd21  = testEq "testResult21" 1 (length fwd21)
-testFwd21a = testIn "testResult21a" result21a fwd21
-bwd21 = bwdApply rul21 result21b
-testBwd21  = testEq "testBwd21"  1 (length $ head bwd21)
-testBwd21a = testIn "testBwd21a" bwd21a (head bwd21)
-
-
-query22    = makeRDFGraphFromN3String query22str
-query22str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?b rel:son ?c . \n"
-
-result22    = makeRDFGraphFromN3String result22str
-result22str = prefix2 ++
-    "?a rel:grandparent ?c . \n"
-
-result22a    = makeRDFGraphFromN3String result22astr
-result22astr = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:Ol4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:Lo4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:Ha4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:El4 . \n"
-
-result22b    = makeRDFGraphFromN3String result22bstr
-result22bstr = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
-
-bwd22a    = makeRDFGraphFromN3String bwd22astr
-bwd22astr = prefix2 ++
-    "pers:Pa2 rel:son      _:p1 . \n" ++
-    "_:p1 rel:son      pers:Ro4 . \n" ++
-    "pers:Pa2 rel:son      _:p2 . \n" ++
-    "_:p2 rel:son      pers:Ol4 . \n"
-
-rul22 = makeN3ClosureSimpleRule scope2 "rul22" query22str result22str
-fwd22 = fwdApply rul22 [graph2]
-testFwd22  = testEq "testResult22" 1 (length fwd22)
-testFwd22a = testIn "testResult22a" result22a fwd22
-bwd22 = bwdApply rul22 result22b
-testBwd22  = testEq "testBwd22"  1 (length $ head bwd22)
-testBwd22a = testIn "testBwd22a" bwd22a (head bwd22)
-
-
-query23    = makeRDFGraphFromN3String query23str
-query23str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result23    = makeRDFGraphFromN3String result23str
-result23str = prefix2 ++
-    "?b rel:brother ?c . \n"
-
-result23a    = makeRDFGraphFromN3String result23astr
-result23astr = prefix2 ++
-    "pers:Gr3 rel:brother pers:Gr3 . \n" ++
-    "pers:Gr3 rel:brother pers:La3 . \n" ++
-    "pers:Gr3 rel:brother pers:Si3 . \n" ++
-    "pers:Gr3 rel:brother pers:Al3 . \n" ++
-    "pers:La3 rel:brother pers:Gr3 . \n" ++
-    "pers:La3 rel:brother pers:La3 . \n" ++
-    "pers:La3 rel:brother pers:Si3 . \n" ++
-    "pers:La3 rel:brother pers:Al3 . \n" ++
-    "pers:Si3 rel:brother pers:Gr3 . \n" ++
-    "pers:Si3 rel:brother pers:La3 . \n" ++
-    "pers:Si3 rel:brother pers:Si3 . \n" ++
-    "pers:Si3 rel:brother pers:Al3 . \n" ++
-    "pers:Al3 rel:brother pers:Gr3 . \n" ++
-    "pers:Al3 rel:brother pers:La3 . \n" ++
-    "pers:Al3 rel:brother pers:Si3 . \n" ++
-    "pers:Al3 rel:brother pers:Al3 . \n" ++
-    "pers:Wi3 rel:brother pers:Wi3 . \n" ++
-    "pers:Ro4 rel:brother pers:Ro4 . \n" ++
-    "pers:Ol4 rel:brother pers:Lo4 . \n" ++
-    "pers:Ol4 rel:brother pers:Ol4 . \n" ++
-    "pers:Lo4 rel:brother pers:Lo4 . \n" ++
-    "pers:Lo4 rel:brother pers:Ol4 . \n" ++
-    "pers:Ha4 rel:brother pers:El4 . \n" ++
-    "pers:Ha4 rel:brother pers:Ha4 . \n" ++
-    "pers:El4 rel:brother pers:El4 . \n" ++
-    "pers:El4 rel:brother pers:Ha4 . \n"
-
-result23b    = makeRDFGraphFromN3String result23bstr
-result23bstr = prefix2 ++
-    "pers:Gr3 rel:brother pers:Gr3 . \n" ++
-    "pers:Gr3 rel:brother pers:La3 . \n"
-
-bwd23a    = makeRDFGraphFromN3String bwd23astr
-bwd23astr = prefix2 ++
-    "_:a1 rel:son pers:Gr3 . \n" ++
-    "_:a1 rel:son pers:Gr3 . \n" ++
-    "_:a2 rel:son pers:Gr3 . \n" ++
-    "_:a2 rel:son pers:La3 . \n"
-
-rul23 = makeN3ClosureSimpleRule scope2 "rul23" query23str result23str
-fwd23 = fwdApply rul23 [graph2]
-testFwd23  = testEq "testResult23" 1 (length fwd23)
-testFwd23a = testIn "testResult23a" result23a fwd23
-bwd23 = bwdApply rul23 result23b
-testBwd23  = testEq "testBwd23"  1 (length $ head bwd23)
-testBwd23a = testIn "testBwd23a" bwd23a (head bwd23)
-
-
---  Test case to return multiple alternative bindings
---
---  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
---
---  a stepBrother b if
---      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)
-
-graph24    = makeRDFGraphFromN3String graph24str
-graph24str = prefix2 ++
-    "pers:Ma2 rel:son     pers:Gr3 . \n" ++
-    "pers:Ma2 rel:stepson pers:St3 . \n"
-
-query24    = makeRDFGraphFromN3String query24str
-query24str = prefix2 ++
-    "?c rel:son ?a     . \n" ++
-    "?c rel:stepson ?b . \n"
-
-result24    = makeRDFGraphFromN3String result24str
-result24str = prefix2 ++
-    "?a rel:stepbrother ?b . \n" ++
-    "?b rel:stepbrother ?a . \n"
-
-result24a    = makeRDFGraphFromN3String result24astr
-result24astr = prefix2 ++
-    "pers:Gr3 rel:stepbrother pers:St3 . \n" ++
-    "pers:St3 rel:stepbrother pers:Gr3 . \n"
-
-bwd24a1    = makeRDFGraphFromN3String bwd24a1str
-bwd24a1str = prefix2 ++
-    "_:c1 rel:son     pers:Gr3 . \n" ++
-    "_:c1 rel:stepson pers:St3 . \n" ++
-    "_:c2 rel:stepson pers:Gr3 . \n" ++
-    "_:c2 rel:son     pers:St3 . \n"
-
-bwd24a2    = makeRDFGraphFromN3String bwd24a2str
-bwd24a2str = prefix2 ++
-    "_:c1 rel:son     pers:Gr3 . \n" ++
-    "_:c1 rel:stepson pers:St3 . \n"
-
-bwd24a3    = makeRDFGraphFromN3String bwd24a3str
-bwd24a3str = prefix2 ++
-    "_:c2 rel:stepson pers:Gr3 . \n" ++
-    "_:c2 rel:son     pers:St3 . \n"
-
-bwd24a4    = makeRDFGraphFromN3String bwd24a4str
-bwd24a4str = prefix2 ++
-    "_:c1 rel:son     pers:Gr3 . \n" ++
-    "_:c1 rel:stepson pers:St3 . \n" ++
-    "_:c2 rel:stepson pers:Gr3 . \n" ++
-    "_:c2 rel:son     pers:St3 . \n"
-
-rul24 = makeN3ClosureSimpleRule scope2 "rul24" query24str result24str
-fwd24 = fwdApply rul24 [graph24]
-testFwd24  = testEq "testResult24" 1 (length fwd24)
-testFwd24a = testIn "testResult24a" result24a fwd24
-bwd24 = bwdApply rul24 result24a
-testBwd24   = testEq "testBwd24"  4 (length bwd24)
-testBwd24a1 = testIn "testBwd24a1" bwd24a1 (bwd24!!0)
-testBwd24a2 = testIn "testBwd24a2" bwd24a2 (bwd24!!1)
-testBwd24a3 = testIn "testBwd24a3" bwd24a3 (bwd24!!2)
-testBwd24a4 = testIn "testBwd24a4" bwd24a4 (bwd24!!3)
-
-
---  bwd chain from partial conclusion
---  Also, fail because conclusion is more than the rule
---  can derive from any input.
-
-query25    = makeRDFGraphFromN3String query25str
-query25str = prefix2 ++
-    "?a rel:son      ?b . \n" ++
-    "?a rel:daughter ?c . \n"
-
-result25    = makeRDFGraphFromN3String result25str
-result25str = prefix2 ++
-    "?b rel:sister  ?c . \n" ++
-    "?c rel:brother ?b . \n"
-
-result25a    = makeRDFGraphFromN3String result25astr
-result25astr = prefix2 ++
-    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
-    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
-    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n"
-
-{-
-result25b    = makeRDFGraphFromN3String result25bstr
-result25bstr = prefix2 ++
-    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n"
--}
-
-result25c    = makeRDFGraphFromN3String result25cstr
-result25cstr = prefix2 ++
-    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
-    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
-    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
-    "pers:xx3 rel:mother  pers:yy3 . \n" ++
-    "pers:yy3 rel:brother pers:xx3 . \n"
-
-result25d    = makeRDFGraphFromN3String result25dstr
-result25dstr = prefix2 ++
-    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
-    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
-    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
-    "pers:xx3 rel:father  pers:yy3 . \n"
-
-conc25    = makeRDFGraphFromN3String conc25str
-conc25str = prefix2 ++
-    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n"
-
-bwd25a    = makeRDFGraphFromN3String bwd25astr
-bwd25astr = prefix2 ++
-    "_:a1 rel:son      pers:Wi3 . \n" ++
-    "_:a1 rel:daughter pers:Ma3 . \n" ++
-    "_:a2 rel:son      pers:Ro4 . \n" ++
-    "_:a2 rel:daughter pers:Rh4 . \n"
-
-rul25 = makeN3ClosureSimpleRule scope2 "rul25" query25str result25str
-fwd25 = fwdApply rul25 [graph2]
-testFwd25  = testEq "testResult25" 1 (length fwd25)
-testFwd25a = testIn "testResult25a" result25a fwd25
-bwd25 = bwdApply rul25 conc25
-testBwd25  = testEq "testBwd25"  1 (length $ head bwd25)
-testBwd25a = testIn "testBwd25a" bwd25a (head bwd25)
--- testBwd25a1 = testEq "testBwd25a" bwd25a (head $ head bwd25)
-bwd25c = bwdApply rul25 result25c
-testBwd25c = testNo "testBwd25c" bwd25c
-bwd25d = bwdApply rul25 result25d
-testBwd25d = testNo "testBwd25d" bwd25d
-
-
-test2 = TestList
-    [ testFwd21
-    , testFwd21a
-    , testBwd21
-    , testBwd21a
-    , testFwd22
-    , testFwd22a
-    , testBwd22
-    , testBwd22a
-    , testFwd23
-    , testFwd23a
-    , testBwd23
-    , testBwd23a
-    , testFwd24, testFwd24a
-    , testBwd24, testBwd24a1, testBwd24a2, testBwd24a3, testBwd24a4
-    , testFwd25
-    , testFwd25a
-    , testBwd25
-    , testBwd25a, testBwd25c, testBwd25d
-    ]
-
---  test3:  check variable binding filters
-
-scope3 = Namespace "scope3"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope3"
-
-query31    = makeRDFGraphFromN3String query31str
-query31str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-modify31 :: RDFVarBindingModify
-modify31 = makeVarFilterModify $ varFilterNE (Var "b") (Var "c")
-
-result31    = makeRDFGraphFromN3String result31str
-result31str = prefix2 ++
-    "?b rel:brother ?c . \n"
-
-result31a    = makeRDFGraphFromN3String result31astr
-result31astr = prefix2 ++
-    "pers:Gr3 rel:brother pers:La3 . \n" ++
-    "pers:Gr3 rel:brother pers:Si3 . \n" ++
-    "pers:Gr3 rel:brother pers:Al3 . \n" ++
-    "pers:La3 rel:brother pers:Gr3 . \n" ++
-    "pers:La3 rel:brother pers:Si3 . \n" ++
-    "pers:La3 rel:brother pers:Al3 . \n" ++
-    "pers:Si3 rel:brother pers:Gr3 . \n" ++
-    "pers:Si3 rel:brother pers:La3 . \n" ++
-    "pers:Si3 rel:brother pers:Al3 . \n" ++
-    "pers:Al3 rel:brother pers:Gr3 . \n" ++
-    "pers:Al3 rel:brother pers:La3 . \n" ++
-    "pers:Al3 rel:brother pers:Si3 . \n" ++
-    "pers:Ol4 rel:brother pers:Lo4 . \n" ++
-    "pers:Lo4 rel:brother pers:Ol4 . \n" ++
-    "pers:Ha4 rel:brother pers:El4 . \n" ++
-    "pers:El4 rel:brother pers:Ha4 . \n"
-
-result31b    = makeRDFGraphFromN3String result31bstr
-result31bstr = prefix2 ++
-    "pers:Gr3 rel:brother pers:Gr3 . \n"
-
-result31c    = makeRDFGraphFromN3String result31cstr
-result31cstr = prefix2 ++
-    "pers:Gr3 rel:brother pers:La3 . \n"
-
-bwd31c    = makeRDFGraphFromN3String bwd31cstr
-bwd31cstr = prefix2 ++
-    "_:a rel:son pers:Gr3 . \n" ++
-    "_:a rel:son pers:La3 . \n"
-
-rul31 = makeN3ClosureRule scope3 "rul31" query31str result31str modify31
-fwd31 = fwdApply rul31 [graph2]
-testFwd31  = testEq "testResult31" 1 (length fwd31)
-testFwd31a = testIn "testResult31a" result31a fwd31
-calcbwd31b = bwdApply rul31 result31b
-testBwd31b = testEq "testBwd31"  0 (length calcbwd31b)
-calcbwd31c = bwdApply rul31 result31c
-testBwd31cn = testEq "testBwd31"  1 (length $ head calcbwd31c)
-testBwd31c  = testIn "testBwd31c" bwd31c (head calcbwd31c)
-
-test3 = TestList
-    [ testFwd31
-    , testFwd31a
-    , testBwd31b
-    , testBwd31cn, testBwd31c
-    ]
-
---  Instance entailment tests
-
-scope4 = Namespace "scope4"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope4"
-
-graph4    = makeRDFGraphFromN3String graph4str
-graph4str = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Rh4 . \n"
-
-vocab4 = allNodes (not . labelIsVar) graph4
-
-name4 = ScopedName scope4 "instance4"
-
-rule4 = makeRdfInstanceEntailmentRule name4 vocab4
-
-fwd42a    = makeRDFGraphFromN3String fwd42astr
-fwd42astr = prefix2 ++
-    "pers:Gr3 rel:son      _:Ro4 ;    \n" ++
-    "         rel:daughter pers:Rh4 . \n"
-
-fwd42b    = makeRDFGraphFromN3String fwd42bstr
-fwd42bstr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter _:Rh4 .    \n"
-
-fwd42c    = makeRDFGraphFromN3String fwd42cstr
-fwd42cstr = prefix2 ++
-    "pers:Gr3 rel:son      _:Ro4 ;    \n" ++
-    "         rel:daughter _:Rh4 .    \n"
-
-fwd42d    = makeRDFGraphFromN3String fwd42dstr
-fwd42dstr = prefix2 ++
-    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
-    "         rel:daughter pers:Rh4 . \n"
-
-fwd42e    = makeRDFGraphFromN3String fwd42estr
-fwd42estr = prefix2 ++
-    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
-    "         rel:daughter pers:Rh4 . \n"
-
-fwd42f    = makeRDFGraphFromN3String fwd42fstr
-fwd42fstr = prefix2 ++
-    "_:Gr3    rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter _:Rh4 .    \n"
-
-fwd42g    = makeRDFGraphFromN3String fwd42gstr
-fwd42gstr = prefix2 ++
-    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
-    "         rel:daughter _:Rh4 .    \n"
-
---  Non-entailments
-
-fwd42w    = makeRDFGraphFromN3String fwd42wstr
-fwd42wstr = prefix2 ++
-    "pers:Gr3 rel:daughter pers:Ro4 . \n"
-
-fwd42x    = makeRDFGraphFromN3String fwd42xstr
-fwd42xstr = prefix2 ++
-    "pers:Gr3 rel:daughter pers:Ro4 . \n"
-
-fwd42y    = makeRDFGraphFromN3String fwd42ystr
-fwd42ystr = prefix2 ++
-    "_:Gr3    rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Ro4 . \n"
-
-fwd42z    = makeRDFGraphFromN3String fwd42zstr
-fwd42zstr = prefix2 ++
-    "_:Gr3    rel:son      _:Ro4 ; \n" ++
-    "         rel:son      _:Rh4 . \n"
-
-
-bwd43 = makeRDFGraphFromN3String bwd43str
-bwd43str = prefix2 ++
-    "_:a1 rel:son      pers:Ro4 . \n" ++
-    "_:a2 rel:daughter pers:Rh4 . \n"
-
-bwd43a = makeRDFGraphFromN3String bwd43astr
-bwd43astr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n"
-
-bwd43b = makeRDFGraphFromN3String bwd43bstr
-bwd43bstr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
-    "pers:Ro4 rel:daughter pers:Rh4 . \n"
-
-bwd43c = makeRDFGraphFromN3String bwd43cstr
-bwd43cstr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
-    "pers:Rh4 rel:daughter pers:Rh4 . \n"
-
-bwd43d = makeRDFGraphFromN3String bwd43dstr
-bwd43dstr = prefix2 ++
-    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n"
-
-bwd43e = makeRDFGraphFromN3String bwd43estr
-bwd43estr = prefix2 ++
-    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
-    "pers:Ro4 rel:daughter pers:Rh4 . \n"
-
-bwd43f = makeRDFGraphFromN3String bwd43fstr
-bwd43fstr = prefix2 ++
-    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
-    "pers:Rh4 rel:daughter pers:Rh4 . \n"
-
-bwd43g = makeRDFGraphFromN3String bwd43gstr
-bwd43gstr = prefix2 ++
-    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n"
-
-bwd43h = makeRDFGraphFromN3String bwd43hstr
-bwd43hstr = prefix2 ++
-    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
-    "pers:Ro4 rel:daughter pers:Rh4 . \n"
-
-bwd43i = makeRDFGraphFromN3String bwd43istr
-bwd43istr = prefix2 ++
-    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
-    "pers:Rh4 rel:daughter pers:Rh4 . \n"
-
---  Check basics
-testRuleName41 = testEq "testRuleName41" name4 (ruleName rule4)
-testVocab41    = testEq "testVocab41"    3     (length vocab4)
-
---  Forward chaining
-fwdApply42      = fwdApply rule4 [graph4]
-testFwdLength42 = testEq "testFwdLength42" 7 (length fwdApply42)
-testFwdApply42a = testIn "testFwdApply42a"  fwd42a fwdApply42
-testFwdApply42b = testIn "testFwdApply42b"  fwd42b fwdApply42
-testFwdApply42c = testIn "testFwdApply42c"  fwd42c fwdApply42
-testFwdApply42d = testIn "testFwdApply42d"  fwd42d fwdApply42
-testFwdApply42e = testIn "testFwdApply42e"  fwd42e fwdApply42
-testFwdApply42f = testIn "testFwdApply42f"  fwd42f fwdApply42
-testFwdApply42g = testIn "testFwdApply42g"  fwd42g fwdApply42
-
---  Backward chaining
-bwdApply43      = bwdApply rule4 bwd43
-testBwdLength43 = testEq "testBwdLength43" 9 (length bwdApply43)
-testBwdApply43a = testIn "testBwdApply43a"  [bwd43a] bwdApply43
-testBwdApply43b = testIn "testBwdApply43b"  [bwd43b] bwdApply43
-testBwdApply43c = testIn "testBwdApply43c"  [bwd43c] bwdApply43
-testBwdApply43d = testIn "testBwdApply43d"  [bwd43d] bwdApply43
-testBwdApply43e = testIn "testBwdApply43e"  [bwd43e] bwdApply43
-testBwdApply43f = testIn "testBwdApply43f"  [bwd43f] bwdApply43
-testBwdApply43g = testIn "testBwdApply43g"  [bwd43g] bwdApply43
-testBwdApply43h = testIn "testBwdApply43h"  [bwd43h] bwdApply43
-testBwdApply43i = testIn "testBwdApply43i"  [bwd43i] bwdApply43
-
---  Entailment checks
-testEntail44a   = testEq "testEntail44a" True  (checkInference rule4 [graph4] fwd42a)
-testEntail44b   = testEq "testEntail44b" True  (checkInference rule4 [graph4] fwd42b)
-testEntail44g   = testEq "testEntail44g" True  (checkInference rule4 [graph4] fwd42g)
-testEntail44w   = testEq "testEntail44w" False (checkInference rule4 [graph4] fwd42w)
-testEntail44x   = testEq "testEntail44x" False (checkInference rule4 [graph4] fwd42x)
-testEntail44y   = testEq "testEntail44y" False (checkInference rule4 [graph4] fwd42y)
-testEntail44z   = testEq "testEntail44z" False (checkInference rule4 [graph4] fwd42z)
-
-test4 = TestList
-    [ testRuleName41
-    , testVocab41
-    , testFwdLength42
-    , testFwdApply42a
-    , testFwdApply42b
-    , testFwdApply42c
-    , testFwdApply42d
-    , testFwdApply42e
-    , testFwdApply42f
-    , testFwdApply42g
-    , testBwdLength43
-    , testBwdApply43a
-    , testBwdApply43b
-    , testBwdApply43c
-    , testBwdApply43d
-    , testBwdApply43e
-    , testBwdApply43f
-    , testBwdApply43g
-    , testBwdApply43h
-    , testBwdApply43i
-    , testEntail44a
-    , testEntail44b
-    , testEntail44g
-    , testEntail44w
-    , testEntail44x
-    , testEntail44y
-    , testEntail44z
-    ]
-
---  Subgraph entailment tests
-
-scope5 = Namespace "scope5"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope5"
-
-graph5    = makeRDFGraphFromN3String graph5str
-graph5str = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Rh4 . \n" ++
-    "pers:Si3 rel:son      pers:Ol4 . \n"
-
-name5 = ScopedName scope5 "subgraph5"
-
-rule5 = makeRdfSubgraphEntailmentRule name5
-
---  Forward chaining excludes null agraph and copy of antecedent
-fwd52a    = makeRDFGraphFromN3String fwd52astr
-fwd52astr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n"
-
-fwd52b    = makeRDFGraphFromN3String fwd52bstr
-fwd52bstr = prefix2 ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n"
-
-fwd52c    = makeRDFGraphFromN3String fwd52cstr
-fwd52cstr = prefix2 ++
-    "pers:Si3 rel:son      pers:Ol4 . \n"
-
-fwd52d    = makeRDFGraphFromN3String fwd52dstr
-fwd52dstr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n"
-
-fwd52e    = makeRDFGraphFromN3String fwd52estr
-fwd52estr = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
-    "pers:Si3 rel:son      pers:Ol4 . \n"
-
-fwd52f    = makeRDFGraphFromN3String fwd52fstr
-fwd52fstr = prefix2 ++
-    "pers:Gr3 rel:daughter pers:Rh4 . \n" ++
-    "pers:Si3 rel:son      pers:Ol4 . \n"
-
---  Check basics
-testRuleName51 = testEq "testRuleName51" name5 (ruleName rule5)
-
---  Forward chaining
-fwdApply52      = fwdApply rule5 [graph5]
-testFwdLength52 = testEq "testFwdLength52" 6 (length fwdApply52)
-testFwdApply52a = testIn "testFwdApply52a"  fwd52a fwdApply52
-testFwdApply52b = testIn "testFwdApply52b"  fwd52b fwdApply52
-testFwdApply52c = testIn "testFwdApply52c"  fwd52c fwdApply52
-testFwdApply52d = testIn "testFwdApply52d"  fwd52d fwdApply52
-testFwdApply52e = testIn "testFwdApply52e"  fwd52e fwdApply52
-testFwdApply52f = testIn "testFwdApply52f"  fwd52f fwdApply52
-
-test5 = TestList
-    [ testRuleName51
-    , testFwdLength52
-    , testFwdApply52a
-    , testFwdApply52b
-    , testFwdApply52c
-    , testFwdApply52d
-    , testFwdApply52e
-    , testFwdApply52f
-    ]
-
---  Simple entailment test
---  Simple entailment provides entailment check only, no forward or
---  backward chaining.  For that use instance- and subgraph- rules.
-
-scope6 = Namespace "scope6"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope6"
-
-graph6    = makeRDFGraphFromN3String graph6str
-graph6str = prefix2 ++
-    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Rh4 . \n" ++
-    "pers:Si3 rel:son      pers:Ol4 ; \n" ++
-    "         rel:son      pers:Lo4 . \n"
-
-name6 = ScopedName scope5 "subgraph6"
-
-rule6 = makeRdfSimpleEntailmentRule name6
-
-simple6a    = makeRDFGraphFromN3String simple6astr
-simple6astr = prefix2 ++
-    "_:Gr3 rel:son      pers:Ro4 ; \n" ++
-    "      rel:daughter pers:Rh4 . \n"
-
-simple6b    = makeRDFGraphFromN3String simple6bstr
-simple6bstr = prefix2 ++
-    "_:Si3 rel:son      pers:Ol4 ; \n" ++
-    "      rel:son      pers:Lo4 . \n"
-
-simple6c    = makeRDFGraphFromN3String simple6cstr
-simple6cstr = prefix2 ++
-    "_:Si3 rel:son      _:Ol4 ; \n" ++
-    "      rel:son      _:Lo4 . \n"
-
-simple6d    = makeRDFGraphFromN3String simple6dstr
-simple6dstr = prefix2 ++
-    "_:Si3 rel:son      _:Ol4 ; \n" ++
-    "      rel:daughter _:Lo4 . \n"
-
-simple6e    = makeRDFGraphFromN3String simple6estr
-simple6estr = prefix2 ++
-    "_:Si3 rel:daughter _:Ol4 ; \n" ++
-    "      rel:mother   _:Lo4 . \n"
-
-testRuleName61 = testEq "testRuleName61" name6 (ruleName rule6)
-testSimple62 = test "testSimple62" (checkInference rule6 [graph6] simple6a)
-testSimple63 = test "testSimple63" (checkInference rule6 [graph6] simple6b)
-testSimple64 = test "testSimple64" (checkInference rule6 [graph6] simple6c)
-testSimple65 = test "testSimple65" (checkInference rule6 [graph6] simple6d)
-testSimple66 = test "testSimple66" (not $ checkInference rule6 [graph6] simple6e)
-testFwd67    = test "testFwd64"    (null $ fwdApply rule6 [graph6])
-testBwd68    = test "testBwd65"    (null $ bwdApply rule6 graph6)
-
-test6 = TestList
-    [ testRuleName61
-    , testSimple62
-    , testSimple63
-    , testSimple64
-    , testSimple65
-    , testSimple66
-    , testFwd67
-    , testBwd68
-    ]
-
---  Test forward chaining node allocation logic
---
---  ?a uncle ?c => ?a father ?b, ?b brother ?c,   ?b allocTo ?a
---
---    Ro4 uncle La3, Ro4 uncle Si3, Rh4 uncle La3, Rh4 uncle Si3
---  =>
---    Ro4 father _:f1, _:f1 brother La3,
---    Ro4 father _:f1, _:f1 brother Si3,
---    Rh4 father _:f2, _:f2 brother La3,
---    Rh4 father _:f2, _:f2 brother Si3
-
-scope7 = Namespace "scope7"
-    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope7"
-
-graph7    = makeRDFGraphFromN3String graph7str
-graph7str = prefix2 ++
-    "pers:Ro4 rel:uncle pers:La3 ; \n" ++
-    "         rel:uncle pers:Si3 . \n" ++
-    "pers:Rh4 rel:uncle pers:La3 ; \n" ++
-    "         rel:uncle pers:Si3 . \n"
-
-query71    = makeRDFGraphFromN3String query71str
-query71str = prefix2 ++
-    "?a rel:uncle ?c . \n"
-
-result71    = makeRDFGraphFromN3String result71str
-result71str = prefix2 ++
-    "?a rel:father  ?b . \n" ++
-    "?b rel:brother ?c . \n"
-
-result71a    = makeRDFGraphFromN3String result71astr
-result71astr = prefix2 ++
-    "pers:Ro4 rel:father  _:f1     . \n" ++
-    "_:f1     rel:brother pers:La3 . \n" ++
-    "pers:Ro4 rel:father  _:f1     . \n" ++
-    "_:f1     rel:brother pers:Si3 . \n" ++
-    "pers:Rh4 rel:father  _:f2     . \n" ++
-    "_:f2     rel:brother pers:La3 . \n" ++
-    "pers:Rh4 rel:father  _:f2     . \n" ++
-    "_:f2     rel:brother pers:Si3 . \n"
-
-rul71 = makeN3ClosureAllocatorRule scope7 "rul71"
-    query71str result71str varBindingId mod71
-
-mod71 = makeNodeAllocTo (Var "b") (Var "a")
-
-var71      = rdfQueryFind query71 graph7
-testVar71  = testEq "testVar71" 4 (length var71)
-var71a     = vbmApply (mod71 (allLabels labelIsVar graph7)) var71
-testVar71a = testEq "testVar71a" 4 (length var71a)
-var71_1    = head var71a
-map71a     = Just (Var "#a")
-map71b     = Just (Var "#b")
-map71c     = Just (Var "#c")
-testVar71_1a = testEq "testVar71_1a" map71a ( vbMap var71_1 (Var "a"))
-testVar71_1b = testEq "testVar71_1b" map71b ( vbMap var71_1 (Var "b"))
-testVar71_1c = testEq "testVar71_1c" map71c ( vbMap var71_1 (Var "c"))
-sub71a     = rdfQuerySubs var71a result71
-testSub71a = testEq "testVar71a" 4 (length sub71a)
-
-fwd71 = fwdApply rul71 [graph7]
-testFwd71  = testEq "testResult71" 1 (length fwd71)
-testFwd71a = testIn "testResult71a" result71a fwd71
-
-test7 = TestList
-    [ testVar71,  testVar71a
-    -- , testVar71_1a, testVar71_1b, testVar71_1c
-    , testSub71a
-    , testFwd71
-    , testFwd71a
-    ]
-
---  Full test suite, main program, and useful expressions for interactive use
-
-allTests = TestList
-  [ test1
-  , test2
-  , test3
-  , test4
-  , test5
-  , test6
-  , test7
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFProofTest.hs,v $
--- $Author: graham $
--- $Revision: 1.21 $
--- $Log: RDFProofTest.hs,v $
--- Revision 1.21  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.20  2003/12/20 12:53:40  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.19  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.18  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.17  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.16  2003/10/24 21:05:09  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.15  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.14  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.13  2003/09/30 20:02:39  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.12  2003/09/30 16:39:41  graham
--- Refactor proof code to use new ruleset logic.
--- Moved some support code from RDFProofCheck to RDFRuleset.
---
--- Revision 1.11  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.10  2003/07/02 22:39:36  graham
--- Subgraph entailment and Graph closure instance entailment rules
--- now tested.  RDF forward chaining revised to combine output graphs,
--- to preserve blank node relationships.
---
--- Revision 1.9  2003/07/02 21:27:30  graham
--- Graph closure with instance rule tested.
--- About to change ProofTest for graph forward chaining to return
--- a single result graph.
---
--- Revision 1.8  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.7  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.6  2003/06/25 10:18:55  graham
--- Added variable binding filter test case for forward and backward chaining.
---
--- Revision 1.5  2003/06/25 09:52:25  graham
--- Replaced Rule class with algebraic data type
---
--- Revision 1.4  2003/06/19 19:49:07  graham
--- RDFProofCheck compiles, but test fails
---
--- Revision 1.3  2003/06/18 18:40:08  graham
--- Basic proof backchaining tests OK.
--- Next:  add filtering on variable bindings.
---
--- Revision 1.2  2003/06/18 01:29:29  graham
--- Fixed up some problems with backward chaining queries.
--- Query test cases still to complete.
--- Proof incomplete.
---
--- Revision 1.1  2003/06/13 21:43:47  graham
--- Add proof test module.
--- Many tests pass, backward chaining still problem.
--- Need to add proof-checker test cases.
---
− Swish/HaskellRDF/RDFQuery.hs 
@@ -1,737 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFQuery.hs,v 1.32 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFQuery
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines functions for querying an RDF graph to obtain
---  a set of variable substitutions, and to apply a set of variable
---  substitutions to a query pattern to obtain a new graph.
---
---  It also defines a few primitive graph access functions.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFQuery
-    ( rdfQueryFind, rdfQueryFilter
-    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify
-    , rdfQueryInstance
-    , rdfQuerySubs, rdfQueryBackSubs
-    , rdfQuerySubsAll
-    , rdfQuerySubsBlank, rdfQueryBackSubsBlank
-    , rdfFindArcs, rdfSubjEq, rdfPredEq, rdfObjEq
-    , rdfFindPredVal, rdfFindPredInt, rdfFindValSubj
-    , rdfFindList
-    -- debug
-    , rdfQuerySubs2 )
-where
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding, nullRDFVarBinding
-    , RDFVarBindingFilter
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( Arc(..), LDGraph(..)
-    , arcSubj, arcPred, arcObj
-    , RDFLabel(..)
-    , isDatatyped, isBlank, isQueryVar
-    , getLiteralText, makeBlank
-    , RDFTriple
-    , RDFGraph, emptyRDFGraph
-    , allLabels, remapLabels
-    , res_rdf_first
-    , res_rdf_rest
-    , res_rdf_nil
-    )
-
-import Swish.HaskellRDF.MapXsdInteger
-    ( mapXsdInteger
-    )
-
-import Swish.HaskellRDF.Datatype
-    ( DatatypeMap(..)
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , makeVarBinding
-    , applyVarBinding, joinVarBindings
-    , VarBindingModify(..)
-    , VarBindingFilter(..)
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( xsd_integer, xsd_nonneg_integer
-    )
-
-import Swish.HaskellUtils.FunctorM
-    ( FunctorM(..) )
-
-import Swish.HaskellUtils.ListHelpers
-    ( listProduct, allp, anyp )
-
-import Control.Monad.State
-    ( State(..), modify )
-
-import Data.Maybe
-    ( catMaybes, isJust, fromJust )
-
-------------------------------------------------------------
---  Primitive RDF graph queries
-------------------------------------------------------------
-
--- |Basic graph-query function.
---  A very basic form of graph query, a query graph and
---  a target graph, and returns a list of 'RDFVarBinding'
---  values, each of which corresponds to a set of variable
---  bindings that make the query graph a subgraph of the
---  target graph, or [] if the query cannot be matched.
---
---  The triples of the query graph are matched sequentially
---  against the target graph, each taking account of any
---  variable bindings that have already been determined,
---  and adding new variable bindings as triples containing
---  query variables are matched against the graph.
---
-rdfQueryFind :: RDFGraph -> RDFGraph -> [RDFVarBinding]
-rdfQueryFind qg =
-    rdfQueryPrim1 matchQueryVariable nullRDFVarBinding (getArcs qg)
-
---  Helper function to match query against a graph.
---  A node-query function is supplied to determine how query nodes
---  are matched against target graph nodes.  Also supplied is
---  an initial variable binding.
---
-rdfQueryPrim1 ::
-    NodeQuery RDFLabel -> RDFVarBinding -> [Arc RDFLabel]
-    -> RDFGraph
-    -> [RDFVarBinding]
-rdfQueryPrim1 _     initv []       _  = [initv]
-rdfQueryPrim1 nodeq initv (qa:qas) tg =
-    let
-        qam  = fmap (applyVarBinding initv) qa      -- subst vars already bound
-        newv = rdfQueryPrim2 nodeq qam tg           -- new bindings, or null
-    in
-        concat
-            [ rdfQueryPrim1 nodeq v2 qas tg
-            | v1 <- newv
-            , let v2 = joinVarBindings initv v1
-            ]
-
---  Match single query term against graph, and return any new sets
---  of variable bindings thus defined, or [] if the query term
---  cannot be matched.  Each of the RDFVarBinding values returned
---  represents an alternative possible match for the query arc.
---
-rdfQueryPrim2 ::
-    NodeQuery RDFLabel -> Arc RDFLabel
-    -> RDFGraph
-    -> [RDFVarBinding]
-rdfQueryPrim2 nodeq qa tg =
-        catMaybes $ map (getBinding nodeq qa) $ getArcs tg
-
--- |RDF query filter.  This function applies a supplied query binding
---  filter to the result from a call of 'rdfQueryFind'.
---
---  If none of the query bindings found satisfy the filter, a null
---  list is returned (which is what 'rdfQueryFind' returns if the
---  query cannot be satisfied).
---
---  (Because of lazy evaluation, this should be as efficient as
---  applying the filter as the search proceeds.  I started to build
---  the filter logic into the query function itself, with consequent
---  increase in complexity, until I remembered lazy evaluation lets
---  me keep things separate.)
---
-rdfQueryFilter ::
-    RDFVarBindingFilter -> [RDFVarBinding] -> [RDFVarBinding]
-rdfQueryFilter qbf qbs = filter (vbfTest qbf) qbs
-
-------------------------------------------------------------
---  Backward-chaining RDF graph queries
-------------------------------------------------------------
-
--- |Reverse graph-query function.
---  Similar to rdfQueryFind, but with different success criteria.
---  The query graph is matched against the supplied graph,
---  but not every triple of the query is required to be matched.
---  Rather, every triple of the target graph must be matched,
---  and substitutions for just the variables thus bound are
---  returned.  In effect, these are subsitutions in the query
---  that entail the target graph (where rdfQueryFind returns
---  substitutions that are entailed by the target graph).
---
---  Multiple substitutions may be used together, so the result
---  returned is a list of lists of query bindings.  Each inner
---  list contains several variable bindings that must all be applied
---  separately to the closure antecendents to obtain a collection of
---  expressions that together are antecedent to the supplied
---  conclusion.  A null list of bindings returned means the
---  conclusion can be inferred without any antecedents.
---
---  Note:  in back-chaining, the conditions required to prove each
---  target triple are derived independently, using the inference rule
---  for each such triple, so there are no requirements to check
---  consistency with previously determined variable bindings, as
---  there are when doing forward chaining.  A result of this is that
---  there may be redundant triples generated by the back-chaining
---  process.  Any process using back-chaining should deal with the
---  results returned accordingly.
---
---  An empty outer list is returned if no combination of
---  substitutions can infer the supplied target.
---
-rdfQueryBack :: RDFGraph -> RDFGraph -> [[RDFVarBinding]]
-rdfQueryBack qg tg =
-    rdfQueryBack1 matchQueryVariable [] (getArcs qg) (getArcs tg)
-
-rdfQueryBack1 ::
-    NodeQuery RDFLabel -> [RDFVarBinding] -> [Arc RDFLabel] -> [Arc RDFLabel]
-    -> [[RDFVarBinding]]
-rdfQueryBack1 _     initv _   []       = [initv]
-rdfQueryBack1 nodeq initv qas (ta:tas) = concat
-    [ rdfQueryBack1 nodeq (nv:initv) qas tas
-    | nv <- rdfQueryBack2 nodeq qas ta ]
-
---  Match a query against a single graph term, and return any new sets of
---  variable bindings thus defined.  Each member of the result is an
---  alternative possible set of variable bindings.  An empty list returned
---  means no match.
---
-rdfQueryBack2 ::
-    NodeQuery RDFLabel -> [Arc RDFLabel] -> Arc RDFLabel
-    -> [RDFVarBinding]
-rdfQueryBack2 nodeq qas ta =
-    [ fromJust b | qa <- qas, let b = getBinding nodeq qa ta, isJust b ]
-
--- |RDF back-chaining query filter.  This function applies a supplied
---  query binding filter to the result from a call of 'rdfQueryBack'.
---
---  Each inner list contains bindings that must all be used to satisfy
---  the backchain query, so if any query binding does not satisfy the
---  filter, the entire corresponding row is removed
-rdfQueryBackFilter ::
-    RDFVarBindingFilter -> [[RDFVarBinding]] -> [[RDFVarBinding]]
-rdfQueryBackFilter qbf qbss = filter (and . map (vbfTest qbf)) qbss
-
--- |RDF back-chaining query modifier.  This function applies a supplied
---  query binding modifier to the result from a call of 'rdfQueryBack'.
---
---  Each inner list contains bindings that must all be used to satisfy
---  a backchaining query, so if any query binding does not satisfy the
---  filter, the entire corresponding row is removed
---
-rdfQueryBackModify ::
-    VarBindingModify a b -> [[VarBinding a b]] -> [[VarBinding a b]]
-rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss
-
---  Auxiliary back-chaining query variable binding modifier function:
---  for a supplied list of variable bindings, all of which must be used
---  together when backchaining:
---  (a) make each list member into a singleton list
---  (b) apply the binding modifier to each such list, which may result
---      in a list with zero, one or more elements.
---  (c) return the listProduct of these, each member of which is
---      an alternative list of variable bindings, where the members of
---      each alternative must be used together.
---
-rdfQueryBackModify1 ::
-    VarBindingModify a b -> [VarBinding a b] -> [[VarBinding a b]]
-rdfQueryBackModify1 qbm qbs = listProduct $ map ((vbmApply qbm) . (:[])) qbs
-
-------------------------------------------------------------
---  Simple entailment graph query
-------------------------------------------------------------
-
--- |Simple entailment (instance) graph query.
---  This function queries a graph to find instances of the
---  query graph in the target graph.  It is very similar
---  to the normal forward chaining query 'rdfQueryFind',
---  except that blank nodes rather than query variable nodes
---  in the query graph are matched against nodes in the target
---  graph.  Neither graph should contain query variables.
---
---  An "instance" is defined by the RDF semantics specification,
---  per <http://www.w3.org/TR/rdf-mt/>, and is obtained by replacing
---  blank nodes with URIs, literals or other blank nodes.  RDF
---  "simple entailment" can be determined in terms of instances.
---  This function looks for a subgraph of the target graph that
---  is an instance of the query graph, which is a necessary and
---  sufficient condition for RDF entailment (see the Interpolation
---  Lemma in RDF Semantics, section 1.2).
---
---  It is anticipated that this query function can be used in
---  conjunction with backward chaining to determine when the
---  search for sufficient antecendents to determine some goal
---  has been concluded.
-rdfQueryInstance :: RDFGraph -> RDFGraph -> [RDFVarBinding]
-rdfQueryInstance qg =
-    rdfQueryPrim1 matchQueryBnode nullRDFVarBinding (getArcs qg)
-
-------------------------------------------------------------
---  Primitive RDF graph query support functions
-------------------------------------------------------------
-
--- |Type of query node testing function.  Return value is:
---  - Nothing    if no match
---  - Just True  if match with new variable binding
---  - Just False if match with new variable binding
-type NodeQuery a = a -> a -> Maybe Bool
-
---  Extract query binding from matching a single query triple with a
---  target triple, returning:
---  - Nothing if the query is not matched
---  - Just nullVarBinding if there are no new variable bindings
---  - Just binding is a new query binding for this match
-getBinding ::
-    NodeQuery RDFLabel -> Arc RDFLabel -> Arc RDFLabel
-    -> Maybe RDFVarBinding
-getBinding nodeq (Arc s1 p1 o1) (Arc s2 p2 o2) =
-    makeBinding [(s1,s2),(p1,p2),(o1,o2)] []
-    where
-        makeBinding [] bs = Just $ makeVarBinding bs
-        makeBinding (vr@(v,r):bvrs) bs =
-            case nodeq v r of
-                Nothing    -> Nothing
-                Just False -> makeBinding bvrs bs
-                Just True  -> makeBinding bvrs (vr:bs)
-
---  Match variable node against target node, returning
---  Nothing if they do not match, Just True if a variable
---  node is matched (thereby creating a new variable binding)
---  or Just False if a non-blank node is matched.
-matchQueryVariable :: NodeQuery RDFLabel
-matchQueryVariable (Var _) _ = Just True
-matchQueryVariable q t
-    | q == t    = Just False
-    | otherwise = Nothing
-
---  Match blank query node against target node, returning
---  Nothing if they do not match, Just True if a blank node
---  is matched (thereby creating a new equivalence) or
---  Just False if a non-blank node is matched.
-matchQueryBnode :: NodeQuery RDFLabel
-matchQueryBnode (Blank _) _ = Just True
-matchQueryBnode q t
-    | q == t    = Just False
-    | otherwise = Nothing
-
-------------------------------------------------------------
---  Substitute results from RDF query back into a graph
-------------------------------------------------------------
-
--- |Graph substitution function.
---  Uses the supplied variable bindings to substitute variables in
---  a supplied graph, returning a list of result graphs corresponding
---  to each set of variable bindings applied to the input graph.
---  This function is used for formward chaining substitutions, and
---  returns only those result graphs for which all query variables
---  are bound.
-rdfQuerySubs :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]
-rdfQuerySubs vars gr =
-    map fst $ filter (null . snd) $ rdfQuerySubsAll vars gr
-
--- |Graph back-substitution function.
---  Uses the supplied variable bindings from 'rdfQueryBack' to perform
---  a series of variable substitutions in a supplied graph, returning
---  a list of lists of result graphs corresponding to each set of variable
---  bindings applied to the input graphs.
---
---  The outer list of the result contains alternative antecedent lists
---  that satisfy the query goal.  Each inner list contains graphs that
---  must all be inferred to satisfy the query goal.
-rdfQueryBackSubs ::
-    [[RDFVarBinding]] -> RDFGraph -> [[(RDFGraph,[RDFLabel])]]
-rdfQueryBackSubs varss gr = [ rdfQuerySubsAll v gr | v <- varss ]
-
--- |Graph substitution function.
---  This function performs the substitutions and returns a list of
---  result graphs each paired with a list unbound variables in each.
-rdfQuerySubsAll :: [RDFVarBinding] -> RDFGraph -> [(RDFGraph,[RDFLabel])]
-rdfQuerySubsAll vars gr = [ rdfQuerySubs2 v gr | v <- vars ]
-
--- |Graph substitution function.
---  This function performs each of the substitutions in 'vars', and
---  replaces any nodes corresponding to unbound query variables
---  with new blank nodes.
-rdfQuerySubsBlank :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]
-rdfQuerySubsBlank vars gr =
-    [ remapLabels vs bs makeBlank g
-    | v <- vars
-    , let (g,vs) = rdfQuerySubs2 v gr
-    , let bs     = allLabels isBlank g
-    ]
-
--- |Graph back-substitution function, replacing variables with bnodes.
---  Uses the supplied variable bindings from 'rdfQueryBack' to perform
---  a series of variable substitutions in a supplied graph, returning
---  a list of lists of result graphs corresponding to each set of variable
---  bindings applied to the input graphs.
---
---  The outer list of the result contains alternative antecedent lists
---  that satisfy the query goal.  Each inner list contains graphs that
---  must all be inferred to satisfy the query goal.
-rdfQueryBackSubsBlank :: [[RDFVarBinding]] -> RDFGraph -> [[RDFGraph]]
-rdfQueryBackSubsBlank varss gr = [ rdfQuerySubsBlank v gr | v <- varss ]
-
---  This function applies a substitution for a single set of variable
---  bindings, returning the result and a list of unbound variables.
---  It uses a state transformer monad to collect the list of
---  unbound variables.
---
---  Adding an empty graph forces elimination of duplicate arcs.
-rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel])
-rdfQuerySubs2 varb gr = (add emptyRDFGraph g,vs)
-    where
-        (g,vs) = runState ( fmapM (mapNode varb) gr ) []
-
---  Auxiliary monad function for rdfQuerySubs2.
---  This returns a state transformer Monad which in turn returns the
---  substituted node value based on the supplied query variable bindings.
---  The monad state is a list of labels which accumulates all those
---  variables seen for which no substitution was available.
-mapNode :: RDFVarBinding -> RDFLabel -> State [RDFLabel] RDFLabel
-mapNode varb lab =
-    case vbMap varb lab of
-        Just v  -> return v
-        Nothing ->
-            if isQueryVar lab then
-                do  { modify (addVar lab)
-                    ; return lab
-                    }
-            else
-                return lab
-
---  Add variable to list of variables, if not already there
-addVar :: RDFLabel -> [RDFLabel] -> [RDFLabel]
-addVar var vars = if var `elem` vars then vars else var:vars
-
-------------------------------------------------------------
---  Simple lightweight query primitives
-------------------------------------------------------------
---
---  [[[TODO:  modify above code to use these for all graph queries]]]
-
--- |rdfFindArcs is the main function here:  it takes a predicate on an
---  RDF statement and a graph, and returns all statements in the graph
---  satisfying that predicate.
---
---  Use combinations of these as follows:
---
---  (a) find all statements with given subject:
---          rdfQuerySimple (rdfSubjEq s)
---  (b) find all statements with given property:
---          rdfQuerySimple (rdfPredEq p)
---  (c) find all statements with given object:
---          rdfQuerySimple (rdfObjEq  o)
---  (d) find all statements matching conjunction of these conditions:
---          rdfQuerySimple (allp [...])
---  (e) find all statements matching disjunction of these conditions:
---          rdfQuerySimple (anyp [...])
---  (See ListHelpers for allp, anyp.)
---
---  Custom predicates can also be used.
---
-rdfFindArcs :: (RDFTriple -> Bool) -> RDFGraph -> [RDFTriple]
-rdfFindArcs p = filter p . getArcs
-
--- |Test if statement has given subject
-rdfSubjEq :: RDFLabel -> RDFTriple -> Bool
-rdfSubjEq s = (s==) . arcSubj
-
--- |Test if statement has given predicate
-rdfPredEq :: RDFLabel -> RDFTriple -> Bool
-rdfPredEq p = (p==) . arcPred
-
--- |Test if statement has given object
-rdfObjEq  :: RDFLabel -> RDFTriple -> Bool
-rdfObjEq o  = (o==) . arcObj
-
-{-
--- |Find statements with given subject
-rdfFindSubj :: RDFLabel -> RDFGraph -> [RDFTriple]
-rdfFindSubj s = rdfFindArcs (rdfSubjEq s)
-
--- |Find statements with given predicate
-rdfFindPred :: RDFLabel -> RDFGraph -> [RDFTriple]
-rdfFindPred p = rdfFindArcs (rdfPredEq p)
--}
-
--- |Find values of given predicate for a given subject
-rdfFindPredVal :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]
-rdfFindPredVal s p = map arcObj . rdfFindArcs (allp [rdfSubjEq s,rdfPredEq p])
-
--- |Find integer values of a given predicate for a given subject
-rdfFindPredInt :: RDFLabel -> RDFLabel -> RDFGraph -> [Integer]
-rdfFindPredInt s p = catMaybes . map getint . filter isint . pvs
-    where
-        pvs = rdfFindPredVal s p
-        isint  = anyp
-            [ isDatatyped xsd_integer
-            , isDatatyped xsd_nonneg_integer
-            ]
-        getint = mapL2V mapXsdInteger . getLiteralText
-
--- |Find all subjects that have a of given value for for a given predicate
-rdfFindValSubj :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]
-rdfFindValSubj p o = map arcSubj . rdfFindArcs (allp [rdfPredEq p,rdfObjEq o])
-
-------------------------------------------------------------
---  List query
-------------------------------------------------------------
-
--- |Return a list of nodes that comprise an rdf:collection value,
---  given the head element of the collection.  If the list is
---  ill-formed then some arbitrary value is returned.
---
-rdfFindList :: RDFGraph -> RDFLabel -> [RDFLabel]
-rdfFindList gr hd = findhead $ rdfFindList gr findrest
-    where
-        findhead  = headOr (const []) $
-                    map (:) (rdfFindPredVal hd res_rdf_first gr)
-        findrest  = headOr res_rdf_nil (rdfFindPredVal hd res_rdf_rest gr)
-        {-
-        findhead  = headOr (const [])
-                    [ (ob:) | Arc _ sb ob <- subgr, sb == res_rdf_first ]
-        findrest  = headOr res_rdf_nil
-                    [ ob | Arc _ sb ob <- subgr, sb == res_rdf_rest  ]
-        subgr     = filter ((==) hd . arcSubj) $ getArcs gr
-        -}
-        headOr    = foldr const
-        -- headOr _ (x:_) = x
-        -- headOr x []    = x
-
-------------------------------------------------------------
---  Interactive tests
-------------------------------------------------------------
-
-{-
-s1 = Blank "s1"
-p1 = Blank "p1"
-o1 = Blank "o1"
-s2 = Blank "s2"
-p2 = Blank "p2"
-o2 = Blank "o2"
-qs1 = Var "s1"
-qp1 = Var "p1"
-qo1 = Var "o1"
-qs2 = Var "s2"
-qp2 = Var "p2"
-qo2 = Var "o2"
-
-qa1 = Arc qs1 qp1 qo1
-qa2 = Arc qs2 qp2 qo2
-qa3 = Arc qs2  p2 qo2
-ta1 = Arc s1 p1 o1
-ta2 = Arc s2 p2 o2
-
-g1  = toRDFGraph [ta1,ta2]
-g2  = toRDFGraph [qa3]
-
-gb1  = getBinding matchQueryVariable qa1 ta1    -- ?s1=_:s1, ?p1=_:p1, ?o1=_:o1
-gvs1 = qbMap (fromJust gb1) qs1                 -- _:s1
-gvp1 = qbMap (fromJust gb1) qp1                 -- _:p1
-gvo1 = qbMap (fromJust gb1) qo1                 -- _:o1
-gvs2 = qbMap (fromJust gb1) qs2                 -- Nothing
-
-gb3  = getBinding matchQueryVariable qa3 ta1    -- Nothing
-gb4  = getBinding matchQueryVariable qa3 ta2    -- ?s2=_:s1, ?o2=_:o1
-
-mqvs1 = matchQueryVariable qs2 s1
-mqvp1 = matchQueryVariable p2  p1
-
---  rdfQueryFind
-
-qfa  = rdfQueryFind g2 g1
-
-qp2a = rdfQueryPrim2 matchQueryVariable qa3 g1
--}
-
-{- more tests
-
-qb1a = rdfQueryBack1 [] [qa1] [ta1,ta2]
-qb1 = rdfQueryBack1 [] [qa1,qa2] [ta1,ta2]
-ql1 = length qb1
-qv1 = map (qb1!!0!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv2 = map (qb1!!0!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv3 = map (qb1!!1!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv4 = map (qb1!!1!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv5 = map (qb1!!2!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv6 = map (qb1!!2!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv7 = map (qb1!!3!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
-qv8 = map (qb1!!3!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
-
-qb2 = rdfQueryBack2 matchQueryVariable [qa1,qa2] ta1
-ql2 = length qb2
-qv1 = map (qbMap $ head qb2)        [qs1,qp1,qo1,qs2,qp2,qo2]
-qv2 = map (qbMap $ head $ tail qb2) [qs1,qp1,qo1,qs2,qp2,qo2]
-qb3 = rdfQueryBack2 matchQueryVariable [qa1,qa3] ta1
-
--}
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFQuery.hs,v $
--- $Author: graham $
--- $Revision: 1.32 $
--- $Log: RDFQuery.hs,v $
--- Revision 1.32  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.31  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.30  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.29  2003/11/14 16:04:43  graham
--- Add primitive query to get integer values from a graph.
---
--- Revision 1.28  2003/11/14 16:01:30  graham
--- Separate RDFVarBinding from module RDFQuery.
---
--- Revision 1.27  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.26  2003/10/16 16:01:48  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.25  2003/10/15 16:40:52  graham
--- Reworked RDFQuery to use new query binding framework.
--- (Note: still uses VarBindingFilter rather than VarBindingModify.
--- The intent is to incorproate the VarBindingModify logic into RDFProof,
--- displaying the existing use of BindingFilter.)
---
--- Revision 1.24  2003/10/09 17:16:13  graham
--- Added test cases to exercise features of rules used to capture
--- RDF semantics.  Also added proof test case using XML literal.
---
--- Revision 1.23  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.22  2003/10/01 00:38:00  graham
--- Correct error in previous commit.
---
--- Revision 1.21  2003/10/01 00:36:25  graham
--- Added RDFGraph method to test for container membership property label.
--- Added RDFQuery filter function to select container membership properties.
---
--- Revision 1.20  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.19  2003/09/30 16:39:41  graham
--- Refactor proof code to use new ruleset logic.
--- Moved some support code from RDFProofCheck to RDFRuleset.
---
--- Revision 1.18  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.17  2003/07/03 20:31:07  graham
--- Add initial draft of datatype framework.
---
--- Revision 1.16  2003/07/02 22:39:36  graham
--- Subgraph entailment and Graph closure instance entailment rules
--- now tested.  RDF forward chaining revised to combine output graphs,
--- to preserve blank node relationships.
---
--- Revision 1.15  2003/07/02 21:27:30  graham
--- Graph closure with instance rule tested.
--- About to change ProofTest for graph forward chaining to return
--- a single result graph.
---
--- Revision 1.14  2003/07/02 13:51:14  graham
--- Intermediate save:  partially coded RDFS rules.
---
--- Revision 1.13  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.12  2003/06/26 15:37:23  graham
--- Added rdfQueryInstance, and tests, all works.
---
--- Revision 1.11  2003/06/25 09:52:25  graham
--- Replaced Rule class with algebraic data type
---
--- Revision 1.10  2003/06/19 19:49:07  graham
--- RDFProofCheck compiles, but test fails
---
--- Revision 1.9  2003/06/19 00:26:29  graham
--- Query binding filter methods tested.
---
--- Revision 1.8  2003/06/18 23:37:53  graham
--- Added query binding filter methods.  Not yet tested.
---
--- Revision 1.7  2003/06/18 14:59:27  graham
--- Augmented query variable binding structure.
--- RDFQuery tests OK.
---
--- Revision 1.6  2003/06/18 01:29:29  graham
--- Fixed up some problems with backward chaining queries.
--- Query test cases still to complete.
--- Proof incomplete.
---
--- Revision 1.5  2003/06/17 17:53:08  graham
--- Added backward chaining query primitive.
---
--- Revision 1.4  2003/06/17 16:29:20  graham
--- Eliminate redundant Maybe in return type of rdfQueryPrim.
--- (A null list suffices for the Nothing case.)
---
--- Revision 1.3  2003/06/17 15:59:09  graham
--- Update to use revised version of remapNodes, which accepts a
--- node-mapping function rather than just a Boolean to control conversion
--- of query variable nodes to blank
--- nodes.
---
--- Revision 1.2  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.1  2003/06/12 00:49:06  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
− Swish/HaskellRDF/RDFQueryTest.hs 
@@ -1,1711 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFQueryTest.hs,v 1.23 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFQueryTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + multi-parameter classes
---
---  This module defines test cases for querying an RDF graph to obtain
---  a set of variable substitutions, and to apply a set of variable
---  substitutions to a query pattern to obtain a new graph.
---
---  It also tests some primitive graph access functions.
---
---------------------------------------------------------------------------------
-
---  WNH RIP OUT module Swish.HaskellRDF.RDFQueryTest
 where
-
-import Swish.HaskellRDF.RDFQuery
-    ( rdfQueryFind, rdfQueryFilter
-    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify
-    , rdfQueryInstance
-    , rdfQuerySubs, rdfQueryBackSubs
-    , rdfQuerySubsAll
-    , rdfQuerySubsBlank, rdfQueryBackSubsBlank
-    , rdfFindArcs, rdfSubjEq, rdfPredEq, rdfObjEq, rdfFindPredVal
-    , rdfFindValSubj, rdfFindPredVal, rdfFindPredInt, rdfFindList
-    -- debug
-    , rdfQuerySubs2
-    )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding, nullRDFVarBinding
-    , RDFVarBindingModify, RDFVarBindingFilter
-    , rdfVarBindingUriRef, rdfVarBindingBlank
-    , rdfVarBindingLiteral
-    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
-    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
-    , rdfVarBindingMemberProp
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( Arc(..), arcSubj
-    , RDFGraph, RDFLabel(..)
-    , isLiteral, isBlank, isQueryVar, makeBlank
-    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
-    , allLabels, remapLabels
-    , mapnode, maplist
-    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..), nullVarBinding
-    , boundVars, subBinding, makeVarBinding
-    , applyVarBinding, joinVarBindings
-    , VarBindingModify(..)
-    , vbmCompatibility, vbmCompose
-    , findCompositions, findComposition
-    , VarBindingFilter(..)
-    , makeVarFilterModify
-    , makeVarTestFilter, makeVarCompareFilter
-    , varBindingId, varFilterDisjunction, varFilterConjunction
-    , varFilterEQ, varFilterNE
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , makeNamespaceQName
-    , ScopedName(..)
-    , getQName
-    , makeScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceXSD
-    , namespaceLang, langName
-    , swishName
-    , rdf_type, rdf_XMLLiteral
-    , xsd_boolean, xsd_integer
-    )
-
-import Swish.HaskellRDF.N3Parser
-    ( ParseResult(..), parseN3fromString )
-
-import Swish.HaskellUtils.QName
-    ( QName(..) )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(Error,Result) )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-import Data.Maybe
-    ( isJust, fromJust )
-
-------------------------------------------------------------
---  misc helpers
-------------------------------------------------------------
-
-newtype Set a = Set [a] deriving Show
-instance (Eq a) => Eq (Set a) where
-    Set v1 == Set v2 = v1 `equiv` v2
-
-test :: String -> Bool -> Test
-test lab tst = TestCase $ assertBool lab tst
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab e a = TestCase $ assertEqual lab e a
-
-testLs :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testLs lab e a = TestCase $ assertEqual lab (Set e) (Set a)
-
-testGr :: String -> String -> [RDFGraph] -> Test
-testGr lab e a = TestCase $ assertBool lab (eg `elem` a)
-    where eg = graphFromString e
-
-graphFromString :: String -> RDFGraph
-graphFromString str = case parseN3fromString str of
-    Result gr -> gr
-    Error msg -> error msg
-
--- Compare lists for set equivalence:
-
-data ListTest a = ListTest [a]
-
-instance (Eq a) => Eq (ListTest a) where
-    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
-
-instance (Show a) => Show (ListTest a) where
-    show (ListTest a) = show a
-
-testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
-
-------------------------------------------------------------
---  test1:  simple query qith URI, literal and blank nodes.
-------------------------------------------------------------
-
-prefix1 =
-    "@prefix ex: <http://example.org/> . \n" ++
-    " \n"
-
-graph1    = graphFromString graph1str
-graph1str = prefix1 ++
-    "ex:s1  ex:p  ex:o1 . \n"  ++
-    "ex:s2  ex:p  \"lit1\" . \n" ++
-    "[ ex:p ex:o3 ] . \n"
-
-query11    = graphFromString query11str
-query11str = prefix1 ++
-    "?s  ex:p  ?o . \n"
-
-result11    = graphFromString result11str
-result11str = prefix1 ++
-    "?s  ex:r  ?o . \n"
-
-result11a = prefix1 ++
-    "ex:s1  ex:r  ex:o1 . \n"
-
-result11b = prefix1 ++
-    "ex:s2  ex:r  \"lit1\" . \n"
-
-result11c = prefix1 ++
-    "[ ex:r ex:o3 ] . \n"
-
-var11         = rdfQueryFind query11 graph1
-testQuery11   = test "testQuery11" (not $ null var11)
-res11         = rdfQuerySubs var11 result11
-testResult11  = testEq "testResult11" 3 (length res11)
-testResult11a = testGr "testResult11a" result11a res11
-testResult11b = testGr "testResult11b" result11b res11
-testResult11c = testGr "testResult11c" result11c res11
-
-test1 = TestList
-    [ testQuery11,   testResult11
-    , testResult11a, testResult11b, testResult11c
-    ]
-
-------------------------------------------------------------
---  test2:  a range of more complex queries based on a
---  single relationship graph.
-------------------------------------------------------------
-
-prefix2 =
-    "@prefix pers: <urn:pers:> . \n"      ++
-    "@prefix rel:  <urn:rel:> . \n"       ++
-    " \n"
-
-graph2    = graphFromString graph2str
-graph2str = prefix2 ++
-    "pers:St1 rel:wife     pers:Do1 ; \n" ++
-    "         rel:daughter pers:Ma2 ; \n" ++
-    "         rel:daughter pers:An2 . \n" ++
-    "pers:Pa2 rel:wife     pers:Ma2 ; \n" ++
-    "         rel:son      pers:Gr3 ; \n" ++
-    "         rel:son      pers:La3 ; \n" ++
-    "         rel:son      pers:Si3 ; \n" ++
-    "         rel:son      pers:Al3 . \n" ++
-    "pers:Br2 rel:wife     pers:Ri2 ; \n" ++
-    "         rel:daughter pers:Ma3 ; \n" ++
-    "         rel:son      pers:Wi3 . \n" ++
-    "pers:Gr3 rel:wife     pers:Ma3 ; \n" ++
-    "         rel:son      pers:Ro4 ; \n" ++
-    "         rel:daughter pers:Rh4 . \n" ++
-    "pers:Si3 rel:wife     pers:Jo3 ; \n" ++
-    "         rel:son      pers:Ol4 ; \n" ++
-    "         rel:son      pers:Lo4 . \n" ++
-    "pers:Al3 rel:wife     pers:Su3 ; \n" ++
-    "         rel:son      pers:Ha4 ; \n" ++
-    "         rel:son      pers:El4 . \n"
-
-query21    = graphFromString query21str
-query21str = prefix2 ++
-    "?a rel:wife ?b . \n"
-
-result21    = graphFromString result21str
-result21str = prefix2 ++
-    "?b rel:husband ?a . \n"
-
-result21a = prefix2 ++
-    "pers:Do1 rel:husband pers:St1 . \n"
-
-result21b = prefix2 ++
-    "pers:Ma2 rel:husband pers:Pa2 . \n"
-
-result21c = prefix2 ++
-    "pers:Ri2 rel:husband pers:Br2 . \n"
-
-result21d = prefix2 ++
-    "pers:Ma3 rel:husband pers:Gr3 . \n"
-
-result21e = prefix2 ++
-    "pers:Jo3 rel:husband pers:Si3 . \n"
-
-result21f = prefix2 ++
-    "pers:Su3 rel:husband pers:Al3 . \n"
-
-var21         = rdfQueryFind query21 graph2
-testQuery21   = test "testQuery21" (not $ null var21)
-res21         = rdfQuerySubs var21 result21
-testResult21  = testEq "testResult21" 6 (length res21)
-testResult21a = testGr "testResult21a" result21a res21
-testResult21b = testGr "testResult21b" result21b res21
-testResult21c = testGr "testResult21c" result21c res21
-testResult21d = testGr "testResult21d" result21d res21
-testResult21e = testGr "testResult21e" result21e res21
-testResult21f = testGr "testResult21f" result21f res21
-
-query22    = graphFromString query22str
-query22str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?b rel:son ?c . \n"
-
-result22    = graphFromString result22str
-result22str = prefix2 ++
-    "?a rel:grandparent ?c . \n"
-
-result22a = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ro4 . \n"
-
-result22b = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
-
-result22c = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Lo4 . \n"
-
-result22d = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ha4 . \n"
-
-result22e = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:El4 . \n"
-
-var22         = rdfQueryFind query22 graph2
-testQuery22   = test "testQuery22" (not $ null var22)
-res22         = rdfQuerySubs var22 result22
-testResult22  = testEq "testResult22" 5 (length res22)
-testResult22a = testGr "testResult22a" result22a res22
-testResult22b = testGr "testResult22b" result22b res22
-testResult22c = testGr "testResult22c" result22c res22
-testResult22d = testGr "testResult22d" result22d res22
-testResult22e = testGr "testResult22e" result22e res22
-
-query23    = graphFromString query23str
-query23str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result23    = graphFromString result23str
-result23str = prefix2 ++
-    "?b rel:brother ?c . \n"
-
-result23a = prefix2 ++
-    "pers:Gr3 rel:brother pers:Gr3 . \n"
-
-result23b = prefix2 ++
-    "pers:Gr3 rel:brother pers:La3 . \n"
-
-result23c = prefix2 ++
-    "pers:Gr3 rel:brother pers:Si3 . \n"
-
-result23d = prefix2 ++
-    "pers:Gr3 rel:brother pers:Al3 . \n"
-
-result23e = prefix2 ++
-    "pers:La3 rel:brother pers:Gr3 . \n"
-
-result23f = prefix2 ++
-    "pers:La3 rel:brother pers:La3 . \n"
-
-result23g = prefix2 ++
-    "pers:La3 rel:brother pers:Si3 . \n"
-
-result23h = prefix2 ++
-    "pers:La3 rel:brother pers:Al3 . \n"
-
-result23i = prefix2 ++
-    "pers:Si3 rel:brother pers:Gr3 . \n"
-
-result23j = prefix2 ++
-    "pers:Si3 rel:brother pers:La3 . \n"
-
-result23k = prefix2 ++
-    "pers:Si3 rel:brother pers:Si3 . \n"
-
-result23l = prefix2 ++
-    "pers:Si3 rel:brother pers:Al3 . \n"
-
-result23m = prefix2 ++
-    "pers:Al3 rel:brother pers:Gr3 . \n"
-
-result23n = prefix2 ++
-    "pers:Al3 rel:brother pers:La3 . \n"
-
-result23o = prefix2 ++
-    "pers:Al3 rel:brother pers:Si3 . \n"
-
-result23p = prefix2 ++
-    "pers:Al3 rel:brother pers:Al3 . \n"
-
-result23q = prefix2 ++
-    "pers:Wi3 rel:brother pers:Wi3 . \n"
-
-result23r = prefix2 ++
-    "pers:Ro4 rel:brother pers:Ro4 . \n"
-
-result23s = prefix2 ++
-    "pers:Ol4 rel:brother pers:Lo4 . \n"
-
-result23t = prefix2 ++
-    "pers:Ol4 rel:brother pers:Ol4 . \n"
-
-result23u = prefix2 ++
-    "pers:Lo4 rel:brother pers:Lo4 . \n"
-
-result23v = prefix2 ++
-    "pers:Lo4 rel:brother pers:Ol4 . \n"
-
-result23w = prefix2 ++
-    "pers:Ha4 rel:brother pers:El4 . \n"
-
-result23x = prefix2 ++
-    "pers:Ha4 rel:brother pers:Ha4 . \n"
-
-result23y = prefix2 ++
-    "pers:El4 rel:brother pers:El4 . \n"
-
-result23z = prefix2 ++
-    "pers:El4 rel:brother pers:Ha4 . \n"
-
-var23         = rdfQueryFind query23 graph2
-testQuery23   = test "testQuery23" (not $ null var23)
-res23         = rdfQuerySubs var23 result23
-testResult23  = testEq "testResult23" 26 (length res23)
-testResult23a = testGr "testResult23a" result23a res23
-testResult23b = testGr "testResult23b" result23b res23
-testResult23c = testGr "testResult23c" result23c res23
-testResult23d = testGr "testResult23d" result23d res23
-testResult23e = testGr "testResult23e" result23e res23
-testResult23f = testGr "testResult23f" result23f res23
-testResult23g = testGr "testResult23g" result23g res23
-testResult23h = testGr "testResult23h" result23h res23
-testResult23i = testGr "testResult23i" result23i res23
-testResult23j = testGr "testResult23j" result23j res23
-testResult23k = testGr "testResult23k" result23k res23
-testResult23l = testGr "testResult23l" result23l res23
-testResult23m = testGr "testResult23m" result23m res23
-testResult23n = testGr "testResult23n" result23n res23
-testResult23o = testGr "testResult23o" result23o res23
-testResult23p = testGr "testResult23p" result23p res23
-testResult23q = testGr "testResult23q" result23q res23
-testResult23r = testGr "testResult23r" result23r res23
-testResult23s = testGr "testResult23s" result23s res23
-testResult23t = testGr "testResult23t" result23t res23
-testResult23u = testGr "testResult23u" result23u res23
-testResult23v = testGr "testResult23v" result23v res23
-testResult23w = testGr "testResult23w" result23w res23
-testResult23x = testGr "testResult23x" result23x res23
-testResult23y = testGr "testResult23y" result23y res23
-testResult23z = testGr "testResult23z" result23z res23
-
--- apply filtering to result:
-filter23 = varFilterNE (Var "b") (Var "c") :: RDFVarBindingFilter
-var23F   = rdfQueryFilter filter23 var23
-res23F   = rdfQuerySubs var23F result23
-testResult23F  = testEq "testResult23" 16 (length res23F)
-testResult23bF = testGr "testResult23b" result23b res23F
-testResult23cF = testGr "testResult23c" result23c res23F
-testResult23dF = testGr "testResult23d" result23d res23F
-testResult23eF = testGr "testResult23e" result23e res23F
-testResult23gF = testGr "testResult23g" result23g res23F
-testResult23hF = testGr "testResult23h" result23h res23F
-testResult23iF = testGr "testResult23i" result23i res23F
-testResult23jF = testGr "testResult23j" result23j res23F
-testResult23lF = testGr "testResult23l" result23l res23F
-testResult23mF = testGr "testResult23m" result23m res23F
-testResult23nF = testGr "testResult23n" result23n res23F
-testResult23oF = testGr "testResult23o" result23o res23F
-testResult23sF = testGr "testResult23s" result23s res23F
-testResult23vF = testGr "testResult23v" result23v res23F
-testResult23wF = testGr "testResult23w" result23w res23F
-testResult23zF = testGr "testResult23z" result23z res23F
-
-
-query24    = graphFromString query24str
-query24str = prefix2 ++
-    "?a rel:daughter ?b . \n" ++
-    "?a rel:daughter ?c . \n"
-
-result24    = graphFromString result24str
-result24str = prefix2 ++
-    "?b rel:sister ?c . \n"
-
-result24a = prefix2 ++
-    "pers:Ma2 rel:sister pers:Ma2 . \n"
-
-result24b = prefix2 ++
-    "pers:Ma2 rel:sister pers:An2 . \n"
-
-result24c = prefix2 ++
-    "pers:An2 rel:sister pers:Ma2 . \n"
-
-result24d = prefix2 ++
-    "pers:An2 rel:sister pers:An2 . \n"
-
-result24e = prefix2 ++
-    "pers:Ma3 rel:sister pers:Ma3 . \n"
-
-result24f = prefix2 ++
-    "pers:Rh4 rel:sister pers:Rh4 . \n"
-
-var24         = rdfQueryFind query24 graph2
-testQuery24   = test "testQuery24" (not $ null var24)
-res24         = rdfQuerySubs var24 result24
-testResult24  = testEq "testResult24" 6 (length res24)
-testResult24a = testGr "testResult24a" result24a res24
-testResult24b = testGr "testResult24b" result24b res24
-testResult24c = testGr "testResult24c" result24c res24
-testResult24d = testGr "testResult24d" result24d res24
-testResult24e = testGr "testResult24e" result24e res24
-testResult24f = testGr "testResult24f" result24f res24
-
-
-query25    = graphFromString query25str
-query25str = prefix2 ++
-    "?a rel:son      ?b . \n" ++
-    "?a rel:daughter ?c . \n"
-
-result25    = graphFromString result25str
-result25str = prefix2 ++
-    "?b rel:sister  ?c . \n" ++
-    "?c rel:brother ?b . \n"
-
-result25a = prefix2 ++
-    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
-    "pers:Ma3 rel:brother pers:Wi3 . \n"
-
-result25b = prefix2 ++
-    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n"
-
-var25         = rdfQueryFind query25 graph2
-testQuery25   = test "testQuery25" (not $ null var25)
-res25         = rdfQuerySubs var25 result25
-testResult25  = testEq "testResult25" 2 (length res25)
-testResult25a = testGr "testResult25a" result25a res25
-testResult25b = testGr "testResult25b" result25b res25
-
-test2 = TestList
-    [ testQuery21,   testResult21
-    , testResult21a, testResult21b, testResult21c
-    , testResult21d, testResult21e, testResult21f
-    , testQuery22,   testResult22
-    , testResult22a, testResult22b, testResult22c
-    , testResult22d, testResult22e
-    , testQuery23,   testResult23
-    , testResult23a, testResult23b, testResult23c
-    , testResult23d, testResult23e, testResult23f
-    , testResult23g, testResult23h, testResult23i
-    , testResult23j, testResult23k, testResult23l
-    , testResult23m, testResult23n, testResult23o
-    , testResult23p, testResult23q, testResult23r
-    , testResult23s, testResult23t, testResult23u
-    , testResult23v, testResult23w, testResult23x
-    , testResult23y, testResult23z
-    , testResult23F
-    , testResult23bF, testResult23cF
-    , testResult23dF, testResult23eF
-    , testResult23gF, testResult23hF, testResult23iF
-    , testResult23jF, testResult23lF
-    , testResult23mF, testResult23nF, testResult23oF
-    , testResult23sF
-    , testResult23vF, testResult23wF
-    , testResult23zF
-    , testQuery24,   testResult24
-    , testResult24a, testResult24b, testResult24c
-    , testResult24d, testResult24e, testResult24f
-    ]
-
-------------------------------------------------------------
---  test handling of unsubstituted variables, and
---  rdfQuerySubsAll, rdfQuerySubsBlank
-------------------------------------------------------------
-
-graph3    = graphFromString graph3str
-graph3str = prefix2 ++
-    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
-    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
-
-query31    = graphFromString query31str
-query31str = prefix2 ++
-    "?a rel:grandparent ?c . \n"
-
-result31    = graphFromString result31str
-result31str = prefix2 ++
-    "?a rel:son ?b . \n" ++
-    "?b rel:son ?c . \n"
-
-result31a = prefix2 ++
-    "pers:Pa2 rel:son ?b . \n" ++
-    "?b rel:son pers:Ro4 . \n"
-
-result31b = prefix2 ++
-    "pers:Pa2 rel:son ?b . \n" ++
-    "?b rel:son pers:Ol4 . \n"
-
-var31          = rdfQueryFind query31 graph3
-testQuery31    = test "testQuery31" (not $ null var31)
-res31pairs     = rdfQuerySubsAll var31 result31
-(res31,res31v) = unzip res31pairs
-testUnsubs31   = testEq "testUnsubs31" 2 (length res31v)
-testUnsubs31a  = testEq "testUnsubs31a" [(Var "b")] (head res31v)
-testUnsubs31b  = testEq "testUnsubs31a" [(Var "b")] (head . tail $ res31v)
-testResult31   = testEq "testResult31" 2 (length res31)
-testResult31a  = testGr "testResult31a" result31a res31
-testResult31b  = testGr "testResult31b" result31b res31
-
-query32    = graphFromString query32str
-query32str = prefix2 ++
-    "?a rel:grandparent ?c . \n"
-
-result32    = graphFromString result32str
-result32str = prefix2 ++
-    "?a rel:wife _:b  . \n" ++
-    "?d rel:any  _:b0 . \n" ++
-    "?a rel:son ?b . \n"    ++
-    "?b rel:son ?c . \n"
-
-result32a = prefix2 ++
-    "pers:Pa2 rel:wife _:b      . \n" ++
-    "_:d0     rel:any  _:b0     . \n" ++
-    "pers:Pa2 rel:son  _:b1     . \n" ++
-    "_:b1     rel:son  pers:Ro4 . \n"
-
-result32b = prefix2 ++
-    "pers:Pa2 rel:wife _:b      . \n" ++
-    "_:d0     rel:any  _:b0     . \n" ++
-    "pers:Pa2 rel:son  _:b1     . \n" ++
-    "_:b1     rel:son  pers:Ol4 . \n"
-
-res32          = rdfQuerySubsBlank var31 result32
-testResult32   = testEq "testResult32" 2 (length res32)
-testResult32a  = testGr "testResult32a" result32a res32
-testResult32b  = testGr "testResult32b" result32b res32
-
-res33          = rdfQuerySubs var31 result32
-testResult33   = testEq "testResult33" 0 (length res33)
-
-test3 = TestList
-    [ testQuery31
-    , testUnsubs31, testUnsubs31a, testUnsubs31b
-    , testResult31, testResult31a, testResult31b
-    , testResult32, testResult32a, testResult32b
-    , testResult33
-    ]
-
---  Debug sequence for rdfQuerySubsBlank
---  (using internals of rdfQuerySubsBlank implementation)
---  res32 = rdfQuerySubsBlank (fromJust var31) result32
-d1 = result32
-d2 = rdfQuerySubs2 (head $ var31) d1
-d3 = allLabels isBlank (fst d2)
-d4 = remapLabels (snd d2) d3 makeBlank (fst d2)
-
-------------------------------------------------------------
---  test4:  test of backward-chaining query
-------------------------------------------------------------
-
-prefix4 =
-    "@prefix pers: <urn:pers:> . \n"      ++
-    "@prefix rel:  <urn:rel:> . \n"       ++
-    " \n"
-
-graph41    = graphFromString graph41str
-graph41str = prefix4 ++
-    "pers:St1 rel:wife     pers:Do1 . \n"
-
-query41    = graphFromString query41str
-query41str = prefix4 ++
-    "?a rel:wife ?b . \n"
-
-result41    = graphFromString result41str
-result41str = prefix4 ++
-    "?b rel:husband ?a . \n"
-
-result41a = prefix4 ++
-    "pers:Do1 rel:husband pers:St1 . \n"
-
-var41          = rdfQueryBack query41 graph41
-testQuery41    = test "testQuery41" (not $ null var41)
-testQuery41a   = testEq "testQuery41a" 1 (length var41)
-res41          = rdfQueryBackSubs var41 result41
-testResult41   = testEq "testResult41" 1 (length res41)
-testResult41a  = testGr "testResult41a" result41a (fst $ unzip $ head res41)
-testUnbound41a = testLs "testUnbound41a" [] (snd $ head $ head res41)
-
-graph42    = graphFromString graph42str
-graph42str = prefix4 ++
-    "pers:Pa2 rel:grandparent pers:Ro4 . \n"
-
-query42    = graphFromString query42str
-query42str = prefix4 ++
-    "?a rel:grandparent ?c . \n"
-
-result42    = graphFromString result42str
-result42str = prefix4 ++
-    "?a rel:son ?b . \n" ++
-    "?b rel:son ?c . \n"
-
-result42a = prefix4 ++
-    "pers:Pa2 rel:son ?b       . \n" ++
-    "?b       rel:son pers:Ro4 . \n"
-
-var42          = rdfQueryBack query42 graph42
-testQuery42    = test "testQuery42" (not $ null var42)
-testQuery42a   = testEq "testQuery42a" 1 (length var42)
-res42          = rdfQueryBackSubs var42 result42
-testResult42   = testEq "testResult42" 1 (length res42)
-testResult42a  = testGr "testResult42a" result42a (fst $ unzip $ head res42)
-testUnbound42a = testLs "testUnbound42a" [(Var "b")] (snd $ head $ head res42)
-
-
-graph43    = graphFromString graph43str
-graph43str = prefix4 ++
-    "pers:Gr3 rel:brother pers:La3 . \n"
-
-query43    = graphFromString query43str
-query43str = prefix4 ++
-    "?b rel:brother ?c . \n"
-
-result43    = graphFromString result43str
-result43str = prefix4 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result43a = prefix4 ++
-    "?a rel:son pers:Gr3 . \n" ++
-    "?a rel:son pers:La3 . \n"
-
-var43          = rdfQueryBack query43 graph43
-testQuery43    = test "testQuery43" (not $ null var43)
-testQuery43a   = testEq "testQuery43a" 1 (length var43)
-res43          = rdfQueryBackSubs var43 result43
-testResult43   = testEq "testResult43" 1 (length res43)
-testResult43a  = testGr "testResult43a" result43a (fst $ unzip $ head res43)
-testUnbound43a = testLs "testUnbound43a" [(Var "a")] (snd $ head $ head res43)
-
-
-graph44    = graphFromString graph44str
-graph44str = prefix4 ++
-    "pers:Pa2 rel:grandson pers:Ro4 . \n"
-
-query44    = graphFromString query44str
-query44str = prefix4 ++
-    "?a rel:grandson ?b . \n" ++
-    "?c rel:grandson ?d . \n"
-
-result44    = graphFromString result44str
-result44str = prefix4 ++
-    "?a rel:son      ?m . \n" ++
-    "?m rel:son      ?b . \n" ++
-    "?c rel:daughter ?n . \n" ++
-    "?n rel:son      ?d . \n"
-
-result44a = prefix4 ++
-    "pers:Pa2 rel:son ?m       . \n" ++
-    "?m       rel:son pers:Ro4 . \n" ++
-    "?c rel:daughter ?n . \n" ++
-    "?n rel:son      ?d . \n"
-unbound44a = [(Var "m"),(Var "c"),(Var "n"),(Var "d")]
-
-result44b = prefix4 ++
-    "?a rel:son      ?m . \n" ++
-    "?m rel:son      ?b . \n" ++
-    "pers:Pa2 rel:daughter ?n .       \n" ++
-    "?n       rel:son      pers:Ro4 . \n"
-unbound44b = [(Var "a"),(Var "m"),(Var "b"),(Var "n")]
-
-var44          = rdfQueryBack query44 graph44
-testQuery44    = test "testQuery44" (not $ null var44)
-testQuery44a   = testEq "testQuery44a"   2 (length var44)
-res44          = rdfQueryBackSubs var44 result44
-testResult44   = testEq "testResult44"   2 (length res44)
-[res44_1,res44_2] = res44
-testResult44a  = testGr "testResult44a"  result44a  (fst $ unzip res44_2)
-testUnbound44a = testLs "testUnbound44a" unbound44a (snd $ head res44_2)
-testResult44b  = testGr "testResult44b"  result44b  (fst $ unzip res44_1)
-testUnbound44b = testLs "testUnbound44b" unbound44b (snd $ head res44_1)
-
---  test45:  multiple substitutions used together
---
---  (?a daughter ?b, ?a son ?c) => ?b brother ?c
---
---  (b1 brother c1, b2 brother c2) if
---      (?a daughter b1, ?a son c1) && (?a daughter b2, ?a son c2)
-
-graph45    = graphFromString graph45str
-graph45str = prefix4 ++
-    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
-    "pers:Ma3 rel:brother pers:Wi3 . \n"
-
-query45    = graphFromString query45str
-query45str = prefix4 ++
-    "?b rel:brother ?c . \n"
-
-result45    = graphFromString result45str
-result45str = prefix4 ++
-    "?a rel:daughter ?b . \n" ++
-    "?a rel:son      ?c . \n"
-
-result45a1 = prefix4 ++
-    "?a rel:daughter pers:Rh4 . \n" ++
-    "?a rel:son      pers:Ro4 . \n"
-unbound45a1 = [(Var "a")]
-
-result45a2 = prefix4 ++
-    "?a rel:daughter pers:Ma3 . \n" ++
-    "?a rel:son      pers:Wi3 . \n"
-unbound45a2 = [(Var "a")]
-
-var45          = rdfQueryBack query45 graph45
-testQuery45    = test "testQuery45" (not $ null var45)
-testQuery45a   = testEq "testQuery45a"   1 (length var45)
-res45          = rdfQueryBackSubs var45 result45
-testResult45   = testEq "testResult45"   1 (length res45)
-[res45_1] = res45
-testResult45_1 = testEq "testResult45_1" 2 (length res45_1)
-[res45_11,res45_12] = res45_1
-testResult45a1  = testGr "testResult45a1"  result45a1  [fst res45_11]
-testUnbound45a1 = testLs "testUnbound45a1" unbound45a1 (snd res45_11)
-testResult45a2  = testGr "testResult45a2"  result45a2  [fst res45_12]
-testUnbound45a2 = testLs "testUnbound45a2" unbound45a2 (snd res45_12)
-
---  test46:  multiple ways to get solution
---
---  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
---
---  a stepBrother b if
---      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)
-
-graph46    = graphFromString graph46str
-graph46str = prefix4 ++
-    "pers:Gr3 rel:stepbrother pers:St3 . \n"
-
-query46    = graphFromString query46str
-query46str = prefix4 ++
-    "?b rel:stepbrother ?c . \n" ++
-    "?c rel:stepbrother ?b . \n"
-
-result46    = graphFromString result46str
-result46str = prefix4 ++
-    "?a rel:son     ?b . \n" ++
-    "?a rel:stepson ?c . \n"
-
-result46a = prefix4 ++
-    "?a rel:son     pers:St3 . \n" ++
-    "?a rel:stepson pers:Gr3 . \n"
-unbound46a = [(Var "a")]
-
-result46b = prefix4 ++
-    "?a rel:son     pers:Gr3 . \n" ++
-    "?a rel:stepson pers:St3 . \n"
-unbound46b = [(Var "a")]
-
-var46          = rdfQueryBack query46 graph46
-testQuery46    = test "testQuery46" (not $ null var46)
-testQuery46a   = testEq "testQuery46a"   2 (length var46)
-res46          = rdfQueryBackSubs var46 result46
-testResult46   = testEq "testResult46"   2 (length res46)
-[res46_1,res46_2] = res46
-testResult46_1 = testEq "testResult46_1" 1 (length res46_1)
-testResult46_2 = testEq "testResult46_2" 1 (length res46_2)
-[res46_11] = res46_1
-[res46_21] = res46_2
-testResult46a  = testGr "testResult46a"  result46a  [fst res46_11]
-testUnbound46a = testLs "testUnbound46a" unbound46a (snd res46_11)
-testResult46b  = testGr "testResult46b"  result46b  [fst res46_21]
-testUnbound46b = testLs "testUnbound46b" unbound46b (snd res46_21)
-
-
---  test47:  multiple ways to multiple solutions
---
---  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
---
---  (a stepBrother b, c stepBrother d) if
---      ((_:e son a, _:e stepSon b) && (_:f son a, _:f stepSon b)) ||
---      ((_:e son a, _:e stepSon b) && (_:f stepSon a, _:f son b)) ||
---      ((_:e stepSon a, _:e son b) && (_:f son a, _:f stepSon b)) ||
---      ((_:e stepSon a, _:e son b) && (_:f stepSon a, _:f son b))
-
-graph47    = graphFromString graph47str
-graph47str = prefix4 ++
-    "pers:Gr3 rel:stepbrother pers:St3 . \n" ++
-    "pers:St3 rel:stepbrother pers:Gr3 . \n"
-
-query47    = graphFromString query47str
-query47str = prefix4 ++
-    "?b rel:stepbrother ?c . \n" ++
-    "?c rel:stepbrother ?b . \n"
-
-result47    = graphFromString result47str
-result47str = prefix4 ++
-    "?a rel:son     ?b . \n" ++
-    "?a rel:stepson ?c . \n"
-
-result47a1 = prefix4 ++
-    "?a rel:son     pers:St3 . \n" ++
-    "?a rel:stepson pers:Gr3 . \n"
-unbound47a1 = [(Var "a")]
-
-result47a2 = prefix4 ++
-    "?a rel:son     pers:Gr3 . \n" ++
-    "?a rel:stepson pers:St3 . \n"
-unbound47a2 = [(Var "a")]
-
-result47b1 = prefix4 ++
-    "?a rel:stepson pers:St3 . \n" ++
-    "?a rel:son     pers:Gr3 . \n"
-unbound47b1 = [(Var "a")]
-
-result47b2 = prefix4 ++
-    "?a rel:stepson pers:St3 . \n" ++
-    "?a rel:son     pers:Gr3 . \n"
-unbound47b2 = [(Var "a")]
-
-result47c1 = prefix4 ++
-    "?a rel:son     pers:St3 . \n" ++
-    "?a rel:stepson pers:Gr3 . \n"
-unbound47c1 = [(Var "a")]
-
-result47c2 = prefix4 ++
-    "?a rel:son     pers:St3 . \n" ++
-    "?a rel:stepson pers:Gr3 . \n"
-unbound47c2 = [(Var "a")]
-
-result47d1 = prefix4 ++
-    "?a rel:stepson pers:St3 . \n" ++
-    "?a rel:son     pers:Gr3 . \n"
-unbound47d1 = [(Var "a")]
-
-result47d2 = prefix4 ++
-    "?a rel:son     pers:St3 . \n" ++
-    "?a rel:stepson pers:Gr3 . \n"
-unbound47d2 = [(Var "a")]
-
-var47          = rdfQueryBack query47 graph47
-testQuery47    = test "testQuery47" (not $ null var47)
-testQuery47a   = testEq "testQuery47a"   4 (length var47)
-res47          = rdfQueryBackSubs var47 result47
-testResult47   = testEq "testResult47"   4 (length res47)
-[res47_1,res47_2,res47_3,res47_4] = res47
-testResult47_1 = testEq "testResult47_1" 2 (length res47_1)
-testResult47_2 = testEq "testResult47_2" 2 (length res47_2)
-testResult47_3 = testEq "testResult47_3" 2 (length res47_3)
-testResult47_4 = testEq "testResult47_4" 2 (length res47_4)
-[res47_11,res47_12] = res47_1
-[res47_21,res47_22] = res47_2
-[res47_31,res47_32] = res47_3
-[res47_41,res47_42] = res47_4
-testResult47a1  = testGr "testResult47a1"  result47a1  [fst res47_11]
-testUnbound47a1 = testLs "testUnbound47a1" unbound47a1 (snd res47_11)
-testResult47a2  = testGr "testResult47a2"  result47a2  [fst res47_12]
-testUnbound47a2 = testLs "testUnbound47a2" unbound47a2 (snd res47_12)
-testResult47b1  = testGr "testResult47b1"  result47b1  [fst res47_21]
-testUnbound47b1 = testLs "testUnbound47b1" unbound47b1 (snd res47_21)
-testResult47b2  = testGr "testResult47b2"  result47b2  [fst res47_22]
-testUnbound47b2 = testLs "testUnbound47b2" unbound47b2 (snd res47_22)
-testResult47c1  = testGr "testResult47c1"  result47c1  [fst res47_31]
-testUnbound47c1 = testLs "testUnbound47c1" unbound47c1 (snd res47_31)
-testResult47c2  = testGr "testResult47c2"  result47c2  [fst res47_32]
-testUnbound47c2 = testLs "testUnbound47c2" unbound47c2 (snd res47_32)
-testResult47d1  = testGr "testResult47d1"  result47d1  [fst res47_41]
-testUnbound47d1 = testLs "testUnbound47d1" unbound47d1 (snd res47_41)
-testResult47d2  = testGr "testResult47d2"  result47d2  [fst res47_42]
-testUnbound47d2 = testLs "testUnbound47d2" unbound47d2 (snd res47_42)
-
-
---  test48:  redundant multiple ways to get solution
---
---  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)
---
---  (a brother b) if
---      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)
-
-graph48    = graphFromString graph48str
-graph48str = prefix4 ++
-    "pers:Gr3 rel:brother pers:La3 . \n"
-
-query48    = graphFromString query48str
-query48str = prefix4 ++
-    "?b rel:brother ?c . \n" ++
-    "?c rel:brother ?b . \n"
-
-result48    = graphFromString result48str
-result48str = prefix4 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result48a = prefix4 ++
-    "?a rel:son pers:La3 . \n" ++
-    "?a rel:son pers:Gr3 . \n"
-unbound48a = [(Var "a")]
-
-result48b = prefix4 ++
-    "?a rel:son pers:Gr3 . \n" ++
-    "?a rel:son pers:La3 . \n"
-unbound48b = [(Var "a")]
-
-var48          = rdfQueryBack query48 graph48
-testQuery48    = test "testQuery48" (not $ null var48)
-testQuery48a   = testEq "testQuery48a"   2 (length var48)
-res48          = rdfQueryBackSubs var48 result48
-testResult48   = testEq "testResult48"   2 (length res48)
-[res48_1,res48_2] = res48
-testResult48_1 = testEq "testResult48_1" 1 (length res48_1)
-testResult48_2 = testEq "testResult48_2" 1 (length res48_2)
-[res48_11] = res48_1
-[res48_21] = res48_2
-testResult48a  = testGr "testResult48a"  result48a  [fst res48_11]
-testUnbound48a = testLs "testUnbound48a" unbound48a (snd res48_11)
-testResult48b  = testGr "testResult48b"  result48b  [fst res48_21]
-testUnbound48b = testLs "testUnbound48b" unbound48b (snd res48_21)
-
-
--- test49: goal not satisfiable by rule
---
---  (?a foo ?b, ?b foo ?a) => (?a bar ?a)
---
---  (a bar b) cannot be deduced directly
-
-graph49    = graphFromString graph49str
-graph49str = prefix4 ++
-    "pers:Gr3 rel:foo pers:La3 . \n"
-
-query49    = graphFromString query49str
-query49str = prefix4 ++
-    "?a rel:bar ?a . \n"
-
-result49    = graphFromString result49str
-result49str = prefix4 ++
-    "?a rel:foo ?b . \n" ++
-    "?b rel:foo ?a . \n"
-
-var49          = rdfQueryBack query49 graph49
-testQuery49    = test "testQuery49" (null var49)
-testQuery49a   = testEq "testQuery49a"   0 (length var49)
-res49          = rdfQueryBackSubs var49 result49
-testResult49   = testEq "testResult49"   0 (length res49)
-
---  test50:  back-chaining with filter
---
---  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)
---
---  (a brother b) if
---      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)
-
-graph50    = graphFromString graph50str
-graph50str = prefix4 ++
-    "pers:Gr3 rel:brother pers:Gr3 . \n"
-
-query50    = graphFromString query50str
-query50str = prefix4 ++
-    "?b rel:brother ?c . \n" ++
-    "?c rel:brother ?b . \n"
-
-result50    = graphFromString result50str
-result50str = prefix4 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result50a = prefix4 ++
-    "?a rel:son pers:Gr3 . \n" ++
-    "?a rel:son pers:Gr3 . \n"
-unbound50a = [(Var "a")]
-
-result50b = prefix4 ++
-    "?a rel:son pers:Gr3 . \n" ++
-    "?a rel:son pers:Gr3 . \n"
-unbound50b = [(Var "a")]
-
-var50          = rdfQueryBack query50 graph50
-testQuery50    = test "testQuery50" (not $ null var50)
-testQuery50a   = testEq "testQuery50a"   2 (length var50)
-res50          = rdfQueryBackSubs var50 result50
-testResult50   = testEq "testResult50"   2 (length res50)
-[res50_1,res50_2] = res50
-testResult50_1 = testEq "testResult50_1" 1 (length res50_1)
-testResult50_2 = testEq "testResult50_2" 1 (length res50_2)
-[res50_11] = res50_1
-[res50_21] = res50_2
-testResult50a  = testGr "testResult50a"  result50a  [fst res50_11]
-testUnbound50a = testLs "testUnbound50a" unbound50a (snd res50_11)
-testResult50b  = testGr "testResult50b"  result50b  [fst res50_21]
-testUnbound50b = testLs "testUnbound50b" unbound50b (snd res50_21)
-
-filter50       = varFilterNE (Var "b") (Var "c") :: RDFVarBindingFilter
-var50F         = rdfQueryBackFilter filter50 var50
-res50F         = rdfQueryBackSubs var50F result50
-testResult50F  = testEq "testResult50F" 0 (length res50F)
-
-
---  Backward substitution query test suite
-
-test4 = TestList
-    [ testQuery41, testQuery41a, testResult41
-    , testResult41a, testUnbound41a
-    , testQuery42, testQuery42a, testResult42
-    , testResult42a, testUnbound42a
-    , testQuery43, testQuery43a, testResult43
-    , testResult43a, testUnbound43a
-    , testQuery44, testQuery44a, testResult44
-    , testResult44a, testUnbound44a
-    , testResult44b, testUnbound44b
-    , testQuery45, testQuery45a, testResult45
-    , testResult45_1
-    , testResult45a1, testUnbound45a1
-    , testResult45a2, testUnbound45a2
-    , testQuery46, testQuery46a, testResult46
-    , testResult46_1, testResult46_2
-    , testResult46a, testUnbound46a
-    , testResult46b, testUnbound46b
-    , testQuery47, testQuery47a, testResult47
-    , testResult47_1, testResult47_2, testResult47_3, testResult47_4
-    , testResult47a1, testUnbound47a1
-    , testResult47a2, testUnbound47a2
-    , testResult47b1, testUnbound47b1
-    , testResult47b2, testUnbound47b2
-    , testResult47c1, testUnbound47c1
-    , testResult47c2, testUnbound47c2
-    , testResult47d1, testUnbound47d1
-    , testResult47d2, testUnbound47d2
-    , testQuery48, testQuery48a, testResult48
-    , testResult48_1, testResult48_2
-    , testResult48a, testUnbound48a
-    , testResult48b, testUnbound48b
-    , testQuery49, testQuery49a, testResult49
-    , testQuery50, testQuery50a, testResult50
-    , testResult50_1, testResult50_2
-    , testResult50a, testUnbound50a
-    , testResult50b, testUnbound50b
-    , testResult50F
-    ]
-
-------------------------------------------------------------
---  Instance query test suite
-------------------------------------------------------------
---
---  The test plan is this:
---  (1) perform a backward chaining query against some desired result.
---      ?f father ?a, ?f father ?b, ?a /= ?b => ?a brother ?b
---      against
---      Gr3 brother La3, Gr3 brother Si3
---      should yield:
---      _:a father Gr3
---      _:a father La3
---      _:b father Gr3
---      _:b father Si3
---  (2) Perform instance query of result against 'graph2' (see above)
---      should yield:
---      _:a = Pa2
---      _:b = Pa2
---  (3) Substitute this into query, should yield:
---      Pa2 father Gr3
---      Pa2 father La3
---      Pa2 father Gr3
---      Pa2 father Si3
---  (4) Use this result in an instance query against 'graph2':  it should
---      match without any variable substitutions, indicating that it is
---      a subgraph
-
-graph61    = graphFromString graph61str
-graph61str = prefix4 ++
-    "pers:Gr3 rel:brother pers:La3 . \n" ++
-    "pers:Gr3 rel:brother pers:Si3 . \n"
-
-query61    = graphFromString query61str
-query61str = prefix4 ++
-    "?b rel:brother ?c . \n"
-
-result61    = graphFromString result61str
-result61str = prefix4 ++
-    "?a rel:son ?b . \n" ++
-    "?a rel:son ?c . \n"
-
-result61a = prefix4 ++
-    "_:a1 rel:son pers:Gr3 . \n" ++
-    "_:a1 rel:son pers:La3 . \n" ++
-    "_:a2 rel:son pers:Gr3 . \n" ++
-    "_:a2 rel:son pers:Si3 . \n"
-
-result63a = prefix4 ++
-    "pers:Pa2 rel:son pers:Gr3 . \n" ++
-    "pers:Pa2 rel:son pers:La3 . \n" ++
-    "pers:Pa2 rel:son pers:Gr3 . \n" ++
-    "pers:Pa2 rel:son pers:Si3 . \n"
-
---  1. Backchain query with blank substutions
-var61          = rdfQueryBack query61 graph61
-testQuery61    = test   "testQuery61" (not $ null var61)
-testQuery61a   = testEq "testQuery61a" 1 (length var61)
-res61          = rdfQueryBackSubsBlank var61 result61
-testResult61   = testEq "testResult61" 1 (length res61)
-[[res61a1,res61a2]] = res61
-res61a         = merge res61a1 res61a2
-testResult61a  = testGr "testResult61a" result61a [res61a]
---  2. Instance query against 'graph2'
-var62          = rdfQueryInstance res61a graph2
-testQuery62    = test   "testQuery62" (not $ null var62)
-testQuery62a   = testEq "testQuery62a" 1 (length var62)
---  3. Substitute into instance query graph
-res63          = rdfQuerySubs var62 res61a
-testQuery63    = test   "testQuery63" (not $ null res63)
-testQuery63a   = testEq "testQuery63a" 1 (length res63)
-[res63a]       = res63
-testResult63a  = testGr "testResult63a" result63a [res63a]
---  4. Repeat instance query against 'graph2'
---     Query bindings should be null.
-var64          = rdfQueryInstance res63a graph2
-testQuery64    = test   "testQuery64" (not $ null var64)
-testQuery64a   = testEq "testQuery64a" 1 (length var64)
-[var64a]       = var64
-testQuery64b   = test   "testQuery64b" (null $ vbEnum var64a)
-
-test6 = TestList
-    [ testQuery61, testQuery61a, testResult61, testResult61a
-    , testQuery62, testQuery62a
-    , testQuery63, testQuery63a, testResult63a
-    , testQuery64, testQuery64a, testQuery64b
-    ]
-
-------------------------------------------------------------
---  Specific test cases
-------------------------------------------------------------
-
---  Back-chaining query binding modifier
-
---  Set up call of rdfQueryBackModify
---  (1) simple filter
---  (2) allocate new binding
-{-
-rdfQueryBackModify ::
-    RDFVarBindingModify -> [[RDFVarBinding]] -> [[RDFVarBinding]]
-rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss
--}
-
-baseex   = "http://example.org/"
-baserdf  = nsURI namespaceRDF
-q_dattyp = (makeScopedName "" baseex "datatype")
-
-v_a   = Var "a"
-v_b   = Var "b"
-v_c   = Var "c"
-v_x   = Var "x"
-v_y   = Var "y"
-v_z   = Var "z"
-u_s   = Res (makeScopedName "" baseex "s")
-u_o   = Res (makeScopedName "" baseex "o")
-u_p   = Res (makeScopedName "" baseex "p")
-u_p1  = Res (makeScopedName "" baseex "p1")
-u_p2a = Res (makeScopedName "" baseex "p2a")
-u_p2b = Res (makeScopedName "" baseex "p2b")
-u_m1  = Res (makeScopedName "" baserdf "_1")
-u_m2  = Res (makeScopedName "" baserdf "_2")
-u_rt  = Res rdf_type
-u_xt  = Res rdf_XMLLiteral
-u_dt  = Res q_dattyp
-l_1   = Lit "l1" Nothing
-l_2   = Lit "l2" (Just $ langName "fr")
-l_3   = Lit "l3" (Just q_dattyp)
-l_4   = Lit "l4" (Just q_dattyp) -- was: (Lang "fr")
-l_5   = Lit "l5" (Just rdf_XMLLiteral)
-b_1   = Blank "1"
-b_2   = Blank "2"
-b_3   = Blank "3"
-b_l1  = Blank "l1"
-b_l2  = Blank "l2"
-
-vbss01a =               -- ?a is uri, ?b is uri
-    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,u_o) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
-    ]
-
-vbss01b =               -- ?c is blank
-    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]
-    ]
-
-vbss01c =               -- ?c is literal
-    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]
-    ]
-
-vbss01d =               -- ?c is untyped literal
-    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]
-    ]
-
-vbss01e =               -- ?c is typed literal
-    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_4) ]
-    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5) ]
-    ]
-
-vbss01f =               -- ?c is XML literal
-    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_5) ]
-    ]
-
-vbss01g =               -- ?b is member property
-    [ makeVarBinding [ (v_a,b_1), (v_b,u_m1), (v_c,u_o) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_m2), (v_c,b_1) ]
-    ]
-
-vbss01h =               -- ?c is datatyped with ?x
-    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]
-    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_dt) ]
-    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]
-    ]
-
-vbss01i =               -- ?c is not datatyped with ?x
-    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]
-    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_xt) ]
-    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]
-    ]
-
-vbss01  = [ vbss01a     -- ?a is uri, ?b is uri
-          , vbss01b     -- ?c is blank
-          , vbss01c     -- ?c is literal
-          , vbss01d     -- ?c is untyped literal
-          , vbss01e     -- ?c is typed literal
-          , vbss01f     -- ?c is XML literal
-          , vbss01g     -- ?b is member property
-          , vbss01h     -- ?c is datatyped with ?x
-          , vbss01i     -- ?c is not datatyped with ?x
-          ]
-
-testBackMod01 = testEq "testBackMod01" vbss01 $
-                rdfQueryBackModify varBindingId vbss01
-
-testBackMod02 = testEq "testBackMod02" [vbss01a,vbss01b,vbss01c,vbss01d] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)
-                    vbss01
-
-testBackMod03 = testEq "testBackMod03" [vbss01f,vbss01i] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingBlank v_a)
-                    vbss01
-
-testBackMod04 = testEq "testBackMod04" vbss01 $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingUriRef v_b)
-                    vbss01
-
-testBackMod05 = testEq "testBackMod05"
-                [vbss01c,vbss01d,vbss01e,vbss01f,vbss01h,vbss01i] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingLiteral v_c)
-                    vbss01
-
-testBackMod06 = testEq "testBackMod06" [vbss01d] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingUntypedLiteral v_c)
-                    vbss01
-
-testBackMod07 = testEq "testBackMod07" [vbss01e,vbss01f,vbss01h,vbss01i] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingTypedLiteral v_c)
-                    vbss01
-
-testBackMod08 = testEq "testBackMod08" [vbss01f] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingXMLLiteral v_c)
-                    vbss01
-
-testBackMod09 = testEq "testBackMod09" [vbss01g] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingMemberProp v_b)
-                    vbss01
-
-testBackMod10 = testEq "testBackMod10" [vbss01h] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingDatatyped v_x v_c)
-                    vbss01
-
-vbss02a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
-          , makeVarBinding [ (v_b,b_l1) ]
-          , makeVarBinding [ (v_b,b_l2) ]
-          ]
-
-vbss02b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]
-          , makeVarBinding [ (v_b,b_l2) ]
-          ]
-
-vbss02c = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-          , makeVarBinding [ (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]
-          ]
-
-vbss02d = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]
-          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]
-          ]
-
-vbss02  = [ vbss02a
-          , vbss02b
-          , vbss02c
-          , vbss02d
-          ]
-
-testBackMod20 = testEq "testBackMod20" vbss02 $
-                rdfQueryBackModify varBindingId vbss02
-
-testBackMod21 = testEq "testBackMod21" [vbss02d] $
-                rdfQueryBackModify
-                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)
-                    vbss02
-
---  Variable binding modifier that adds new bindings, if certain
---  others are present.
-vbm22 = VarBindingModify
-        { vbmName  = swishName "vbm22"
-        , vbmApply = concatMap apply1
-        , vbmVocab = [v_a,v_b,v_x,v_y]
-        , vbmUsage = [[v_y]]
-        }
-    where
-        apply1 :: RDFVarBinding -> [RDFVarBinding]
-        apply1 vb = apply2 vb (vbMap vb v_a) (vbMap vb v_b) (vbMap vb v_x)
-        apply2 vb (Just a) (Just b) (Just _) =
-            [ joinVarBindings nva vb, joinVarBindings nvb vb ]
-            where
-                nva = makeVarBinding [(v_y,a)]
-                nvb = makeVarBinding [(v_y,b)]
-        apply2 _ _ _ _ = []
-
-vbss02dy = sequence
-    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]
-      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]
-      ]
-    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]
-      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]
-      ]
-    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,u_p2b) ]
-      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,b_l2)  ]
-      ]
-    , [ makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]
-      , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]
-      ]
-    , [ makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]
-      , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]
-      ]
-    ]
-
-testBackMod22 = testEq "testBackMod22" vbss02dy $
-                rdfQueryBackModify vbm22 vbss02
-
-
---  simplified version of above for debugging --
-
-vbss03a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_b,b_l1) ]
-          ]
-
-vbss03b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-          ]
-
-vbss03  = [ vbss03a
-          , vbss03b
-          ]
-
-vbss03by = sequence
-    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]
-      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]
-      ]
-    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]
-      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]
-      ]
-    ]
-
-testBackMod30 = testEq "testBackMod30" vbss03by $
-                rdfQueryBackModify vbm22 vbss03
-
-test7 = TestList
-    [ testBackMod01, testBackMod02, testBackMod03, testBackMod04
-    , testBackMod05, testBackMod06, testBackMod07, testBackMod08
-    , testBackMod09, testBackMod10
-    , testBackMod20, testBackMod21, testBackMod22
-    , testBackMod30
-    ]
-
-------------------------------------------------------------
---  Test simple value and list queries
-------------------------------------------------------------
-
-namespacetest    =
-    Namespace   "test"   "urn:test:"
-namespacelist    =
-    Namespace   "list"   "urn:list:"
-
-qntest loc = ScopedName namespacetest loc
-qnlist loc = ScopedName namespacelist loc
-
-prefixlist =
-    "@prefix rdf  : <" ++ nsURI namespaceRDF ++ "> . \n"  ++
-    "@prefix xsd  : <" ++ nsURI namespaceXSD ++ "> . \n"  ++
-    "@prefix test : <" ++ nsURI namespacetest ++ "> . \n" ++
-    "@prefix list : <" ++ nsURI namespacelist ++ "> . \n" ++
-    " \n"
-
-graphlist    = graphFromString graphliststr
-graphliststr = prefixlist ++
-    "test:a rdf:type test:C1 ; "                   ++
-    "  test:p test:item1 ; "                       ++
-    "  test:p test:item2 . "                       ++
-    "test:b rdf:type test:C1 ; "                   ++
-    "  test:p \"1\"^^xsd:integer ; "               ++
-    "  test:p \"2\"^^xsd:integer ; "               ++
-    "  test:p \"3\"^^xsd:integer . "               ++
-    "test:c rdf:type test:C1 ; "                   ++
-    "  test:q \"1\"^^xsd:integer ; "               ++
-    "  test:q \"2\"^^xsd:boolean ; "               ++
-    "  test:q \"3\" . "                            ++
-    "list:three :- (list:_1 list:_2 list:_3) . \n" ++
-    "list:empty :- () . \n"
-
-testC1  = Res (qntest "C1")
-testabc = [ Res (qntest "a"),Res (qntest "b"),Res (qntest "c") ]
-testp   = Res (qntest "p")
-testq   = Res (qntest "q")
-testi12 = [ Res (qntest "item1"),Res (qntest "item2") ]
-test123 = [ Lit "1" (Just xsd_integer)
-          , Lit "2" (Just xsd_integer)
-          , Lit "3" (Just xsd_integer)
-          ]
-test1fp = [ Lit "1" (Just xsd_integer)
-          , Lit "2" (Just xsd_boolean)
-          , Lit "3" Nothing
-          ]
-
-list01 = [Res (qnlist "_1"),Res (qnlist "_2"),Res (qnlist "_3")]
-list02 = []
-
-testVal01  = testEqv "testVal01" testabc $
-                rdfFindValSubj res_rdf_type testC1 graphlist
-testVal02  = testEqv "testVal02" testi12 $
-                rdfFindPredVal (testabc!!0) testp graphlist
-testVal03  = testEqv "testVal03" test123 $
-                rdfFindPredVal (testabc!!1) testp graphlist
-testVal04  = testEqv "testVal04" test1fp $
-                rdfFindPredVal (testabc!!2) testq graphlist
-testVal05  = testEqv "testVal05" [] $
-                rdfFindPredVal (testabc!!2) testp graphlist
-testVal06  = testEqv "testVal06" [] $
-                rdfFindPredInt (testabc!!0) testp graphlist
-testVal07  = testEqv "testVal07" [1,2,3] $
-                rdfFindPredInt (testabc!!1) testp graphlist
-testVal08  = testEqv "testVal08" [1] $
-                rdfFindPredInt (testabc!!2) testq graphlist
-
-testlist01 = testEq "testlist01" list01 $
-    rdfFindList graphlist (Res $ qnlist "three")
-testlist02 = testEq "testlist02" list02 $
-    rdfFindList graphlist (Res $ qnlist "empty")
-
-test8 = TestList
-    [ testVal01, testVal02, testVal03, testVal04
-    , testVal05, testVal06, testVal07, testVal08
-    , testlist01, testlist02
-    ]
-
-{-----
-queryList :: RDFGraph -> RDFLabel -> [RDFLabel]
--- queryList gr res_rdf_nil = []
--- queryList gr hd          = findhead g:rdfQueryList gr (findrest g)
-queryList gr hd
-    | hd == res_rdf_nil = []
-    | otherwise         = (findhead g):(queryList gr (findrest g))
-    where
-        g = subgr gr hd
-
-findhead g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_first ]
-findrest g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_rest  ]
-subgr g h  = filter ((==) h . arcSubj) $ getArcs g
-headOrNil  = foldr const res_rdf_nil
-
-th1  = (Res $ qnlist "empty")
-th3  = (Res $ qnlist "three")
-th3a = subgr graphlist th3
-th3b = findhead th3a
-th3c = findrest th3a
-tl3c = queryList graphlist th3c
-th3d = subgr graphlist th3c
-th3e = findhead th3d
-th3f = findrest th3d
-
-tl3  = queryList graphlist th3
------}
-
-------------------------------------------------------------
---  Full test suite, main program,
---  and useful expressions for interactive use
-------------------------------------------------------------
-
-allTests = TestList
-  [ test1
-  , test2
-  , test3
-  , test4
-  , test6
-  , test7
-  , test8
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-shres32 = TestCase $ assertString (show res32)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFQueryTest.hs,v $
--- $Author: graham $
--- $Revision: 1.23 $
--- $Log: RDFQueryTest.hs,v $
--- Revision 1.23  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.22  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.21  2003/12/20 12:53:40  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.20  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.19  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.18  2003/11/24 15:46:03  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.17  2003/11/14 16:04:43  graham
--- Add primitive query to get integer values from a graph.
---
--- Revision 1.16  2003/11/14 16:01:30  graham
--- Separate RDFVarBinding from module RDFQuery.
---
--- Revision 1.15  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.14  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.13  2003/10/15 16:40:52  graham
--- Reworked RDFQuery to use new query binding framework.
--- (Note: still uses VarBindingFilter rather than VarBindingModify.
--- The intent is to incorproate the VarBindingModify logic into RDFProof,
--- displaying the existing use of BindingFilter.)
---
--- Revision 1.12  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.11  2003/07/02 22:39:36  graham
--- Subgraph entailment and Graph closure instance entailment rules
--- now tested.  RDF forward chaining revised to combine output graphs,
--- to preserve blank node relationships.
---
--- Revision 1.10  2003/06/26 15:37:23  graham
--- Added rdfQueryInstance, and tests, all works.
---
--- Revision 1.9  2003/06/19 00:26:29  graham
--- Query binding filter methods tested.
---
--- Revision 1.8  2003/06/18 14:59:27  graham
--- Augmented query variable binding structure.
--- RDFQuery tests OK.
---
--- Revision 1.7  2003/06/18 13:47:33  graham
--- Backchaining query tests complete.
---
--- Revision 1.6  2003/06/18 01:29:29  graham
--- Fixed up some problems with backward chaining queries.
--- Query test cases still to complete.
--- Proof incomplete.
---
--- Revision 1.5  2003/06/17 17:53:08  graham
--- Added backward chaining query primitive.
---
--- Revision 1.4  2003/06/17 16:29:20  graham
--- Eliminate redundant Maybe in return type of rdfQueryPrim.
--- (A null list suffices for the Nothing case.)
---
--- Revision 1.3  2003/06/17 15:59:09  graham
--- Update to use revised version of remapNodes, which accepts a
--- node-mapping function rather than just a Boolean to control conversion
--- of query variable nodes to blank
--- nodes.
---
--- Revision 1.2  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.1  2003/06/12 00:49:06  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
− Swish/HaskellRDF/RDFRuleset.hs 
@@ -1,621 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFRuleset.hs,v 1.20 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFRuleset
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines some datatypes and functions that are
---  used to define rules and rulesets over RDF graphs
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFRuleMap
-    , RDFClosure, RDFRuleset, RDFRulesetMap
-    , nullRDFFormula
-    , GraphClosure(..), makeGraphClosureRule
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    , makeRDFClosureRule
-    , makeN3ClosureRule
-    , makeN3ClosureSimpleRule
-    , makeN3ClosureModifyRule
-    , makeN3ClosureAllocatorRule
-    , makeNodeAllocTo
-    -- for debugging
-    , graphClosureFwdApply, graphClosureBwdApply
-    )
-where
-
-import Swish.HaskellRDF.RDFQuery
-    ( rdfQueryFind
-    , rdfQueryBack, rdfQueryBackModify
-    , rdfQuerySubs
-    , rdfQuerySubsBlank
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( Label (..), RDFLabel(..), RDFGraph
-    , makeBlank, newNodes
-    , merge, allLabels
-    , toRDFGraph, emptyRDFGraph )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding, RDFVarBindingModify )
-
-import Swish.HaskellRDF.N3Parser
-    ( parseN3fromString )
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..), RulesetMap
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Formula(..), Rule(..), RuleMap
-    , fwdCheckInference
-    , nullScope
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( makeVarBinding
-    , applyVarBinding, joinVarBindings
-    , VarBindingModify(..)
-    , vbmCompose
-    , varBindingId
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..) )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName )
-
-{--import Swish.HaskellRDF.Proof
-    ( Proof(..), Step(..) )
--}-
-import Swish.HaskellRDF.GraphClass
-    ( Label(..), Arc(..), LDGraph(..) )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv, flist )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(..) )
-
-import Data.List
-    ( nub )
-
-
-------------------------------------------------------------
---  Datatypes for RDF ruleset
-------------------------------------------------------------
-
-type RDFFormula     = Formula RDFGraph
-
-type RDFRule        = Rule RDFGraph
-
-type RDFRuleMap     = RuleMap RDFGraph
-
-type RDFClosure     = GraphClosure RDFLabel
-
-type RDFRuleset     = Ruleset RDFGraph
-
-type RDFRulesetMap  = RulesetMap RDFGraph
-
-------------------------------------------------------------
---  Declare null RDF formula
-------------------------------------------------------------
-
-nullRDFFormula :: Formula RDFGraph-nullRDFFormula = Formula
-    { formName = ScopedName nullScope "nullRDFGraph"
-    , formExpr = emptyRDFGraph
-    }
-
-------------------------------------------------------------
---  Datatype for graph closure rule
-------------------------------------------------------------
-
--- |Datatype for constructing a graph closure rule
-data GraphClosure lb = GraphClosure
-    { nameGraphRule :: ScopedName   -- ^ Name of rule for proof display
-    , ruleAnt       :: [Arc lb]     -- ^ Antecedent triples pattern
-                                    --   (may include variable nodes)
-    , ruleCon       :: [Arc lb]     -- ^ Consequent triples pattern
-                                    --   (may include variable nodes)
-    , ruleModify    :: VarBindingModify lb lb
-                                    -- ^ Structure that defines additional
-                                    --   constraints and/or variable
-                                    --   bindings based on other matched
-                                    --   query variables.  Matching the
-                                    --   antecedents.  Use 'varBindingId' if
-                                    --   no additional variable constraints
-                                    --   or bindings are added beyond those
-                                    --   arising from graph queries.
-    }
-
-instance (Label lb) => Eq (GraphClosure lb) where
-    c1 == c2 = (nameGraphRule c1 == nameGraphRule c2) &&
-               (ruleAnt c1) `equiv` (ruleAnt c2) &&
-               (ruleCon c1) `equiv` (ruleCon c2)
-
-instance (Label lb) => Show (GraphClosure lb) where
-    show c = "GraphClosure "++show (nameGraphRule c)
-
-------------------------------------------------------------
---  Define inference rule based on RDF graph closure rule
-------------------------------------------------------------
-
--- |Define a value of type Rule based on an RDFClosure value.
-makeGraphClosureRule :: GraphClosure RDFLabel -> Rule RDFGraph
-makeGraphClosureRule grc = newrule
-    where
-        newrule = Rule
-            { ruleName       = nameGraphRule grc
-            , fwdApply       = graphClosureFwdApply grc
-            , bwdApply       = graphClosureBwdApply grc
-            , checkInference = fwdCheckInference newrule
-            }
-
---  Forward chaining function based on RDF graph closure description
---
---  Note:  antecedents here are presumed to share bnodes.
---
-graphClosureFwdApply :: GraphClosure RDFLabel -> [RDFGraph] -> [RDFGraph]
-graphClosureFwdApply grc grs =
-    let gr   = if null grs then emptyRDFGraph else foldl1 add grs
-        vars = queryFind (ruleAnt grc) gr
-        varm = vbmApply (ruleModify grc) vars
-        cons = querySubs varm (ruleCon grc)
-    in
-        {-
-        seq cons $
-        seq (trace "\ngraphClosureFwdApply") $
-        seq (traceShow "\nvars: " vars) $
-        seq (traceShow "\nvarm: " varm) $
-        seq (traceShow "\ncons: " cons) $
-        seq (trace "\n") $
-        -}
-        --  Return null list or single result graph that is the union
-        --  (not merge) of individual results:
-        if null cons then [] else [foldl1 add cons]
-        -- cons {- don't merge results -}
-
---  Backward chaining function based on RDF graph closure description
-graphClosureBwdApply :: GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]
-graphClosureBwdApply grc gr =
-    let vars = rdfQueryBackModify (ruleModify grc) $
-               queryBack (ruleCon grc) gr
-        --  This next function eliminates duplicate variable bindings.
-        --  It is strictly redundant, but comparing variable
-        --  bindings is much cheaper than comparing graphs.
-        --  I don't know if many duplicate graphs will be result
-        --  of exact duplicate variable bindings, so this may be
-        --  not very effective.
-        varn = map nub vars
-    in
-        --  The 'nub ante' below eliminates duplicate antecedent graphs,
-        --  based on graph matching, which tests for equivalence under
-        --  bnode renaming, with a view to reducing redundant arcs in
-        --  the merged antecedent graph, hence less to prove in
-        --  subsequent back-chaining steps.
-        --
-        --  Each antecedent is reduced to a single RDF graph, when
-        --  bwdApply specifies a list of expressions corresponding to
-        --  each antecedent.
-        [ [foldl1 merge (nub ante)]
-          | vs <- varn
-          , let ante = querySubsBlank vs (ruleAnt grc) ]
-
-------------------------------------------------------------
---  RDF graph query and substitution support functions
-------------------------------------------------------------
-
-queryFind :: [Arc RDFLabel] -> RDFGraph -> [RDFVarBinding]
-queryFind qas tg = rdfQueryFind (toRDFGraph qas) tg
-
-queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]
-queryBack qas tg = rdfQueryBack (toRDFGraph qas) tg
-
-querySubs :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]
-querySubs vars qas =
-    {-
-    seq (trace "\nquerySubs") $
-    seq (traceShow "\nvars: " vars)
-    seq (traceShow "\narcs: "  qas)
-    seq (trace "\n") $
-    -}
-    rdfQuerySubs vars (toRDFGraph qas)
-
-querySubsBlank :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]
-querySubsBlank vars qas = rdfQuerySubsBlank vars (toRDFGraph qas)
-
-------------------------------------------------------------
---  Method for creating an RDF formula value from N3 text
-------------------------------------------------------------
-
--- |Helper function to parse a string containing Notation3
---  and return the corresponding RDFGraph value.
-makeRDFGraphFromN3String :: String -> RDFGraph
-makeRDFGraphFromN3String str = case parseN3fromString str of
-    Error  msg -> error msg
-    Result gr  -> gr
-
--- |Create an RDF formula given:
---  a namespace, a local name and a Notation 3 string that
---  is parsed to yield an RDF graph value.
-makeRDFFormula ::
-    Namespace -> String -> String -> RDFFormula
-makeRDFFormula scope local gr = Formula
-    { formName = ScopedName scope local
-    , formExpr = makeRDFGraphFromN3String gr
-    }
-
-------------------------------------------------------------
---  Create an RDF closure rule from supplied graphs
-------------------------------------------------------------
-
--- |Constructs an RDF graph closure rule.  That is, a rule that
---  given some set of antecedent statements returns new statements
---  that may be added to the graph.
---
---  sname   is a scoped name for the new rule.
---  antgrs  is a list of RDFGraphs that are the entecedent of the rule.
---          (Note:  bnodes and variable names are assumed to be shared
---          by all the entecedent graphs supplied.  [[[is this right?]]])
---  congr   is an RDFGraph containing that is the consequent graph.
---  vmod    is a variable binding modifier value that may impose
---          additional conditions on the variable bindings that
---          can be used for this inference rule, or which may
---          cause new values to be allocated for unbound variables.
---          These modifiers allow for certain inference patterns
---          that are not captured by simple "closure rules", such
---          as the allocation of bnodes corresponding to literals,
---          and are an extension point for incorporating datatypes
---          into an inference process.
---          If no additional constraints or variable bindings are
---          to be applied, use value 'varBindingId'
---
-makeRDFClosureRule ::
-    ScopedName -> [RDFGraph] -> RDFGraph -> RDFVarBindingModify
-    -> RDFRule
-makeRDFClosureRule sname antgrs congr vmod = makeGraphClosureRule
-    GraphClosure
-        { nameGraphRule = sname
-        , ruleAnt       = concatMap getArcs antgrs
-        , ruleCon       = getArcs congr
-        , ruleModify    = vmod
-        }
-
-------------------------------------------------------------
---  Methods to create an RDF closure rule from N3 input
-------------------------------------------------------------
---
---  These functions are used internally by Swish to construct
---  rules from textual descriptions.
-
--- |Constructs an RDF graph closure rule.  That is, a rule that
---  given some set of antecedent statements returns new statements
---  that may be added to the graph.  This is the basis for
---  implementation of most of the inference rules given in the
---  RDF formal semantics document.
---
---  scope   is a namespace to which the rule is allocated
---  local   is a local name for the rule in the given namespace
---  ant     is a string containing the Notation3 representation
---          of the antecedent graph.  (Note: multiple antecedents
---          can be handled by combining multiple graphs.)
---  con     is a string containing the Notation3 representation
---          of the consequent graph.
---  vmod    is a variable binding modifier value that may impose
---          additional conditions on the variable bindings that
---          can be used for this inference rule, or which may
---          cause new values to be allocated for unbound variables.
---          These modifiers allow for certain inference patterns
---          that are not captured by simple "closure rules", such
---          as the allocation of bnodes corresponding to literals,
---          and are an extension point for incorporating datatypes
---          into an inference process.
---          If no additional constraints or variable bindings are
---          to be applied, use value 'varBindingId'
---
-makeN3ClosureRule ::
-    Namespace -> String
-    -> String -> String -> RDFVarBindingModify
-    -> RDFRule
-makeN3ClosureRule scope local ant con vmod =
-    makeRDFClosureRule (ScopedName scope local) [antgr] congr vmod
-    where
-        antgr = makeRDFGraphFromN3String ant
-        congr = makeRDFGraphFromN3String con
-
--- |Construct a simple RDF graph closure rule without
---  additional node allocations or variable binding constraints.
---
-makeN3ClosureSimpleRule ::
-    Namespace -> String -> String -> String -> RDFRule
-makeN3ClosureSimpleRule scope local ant con =
-    makeN3ClosureRule scope local ant con varBindingId
-
--- |Constructs an RDF graph closure rule that incorporates
---  a variable binding filter and a variable binding modifier.
---
---  scope   is a namespace to which the rule is allocated
---  local   is a local name for the rule in the given namespace
---  ant     is a string containing the Notation3 representation
---          of the antecedent graph.  (Note: multiple antecedents
---          can be handled by combining multiple graphs.)
---  con     is a string containing the Notation3 representation
---          of the consequent graph.
---  vflt    is a variable binding modifier value that may impose
---          additional conditions on the variable bindings that
---          can be used for this inference rule.
---          These modifiers allow for certain inference patterns
---          that are not captured by simple "closure rules", such
---          as deductions that pertain only to certain kinds of
---          nodes in a graph.
---  vmod    is a variable binding modifier that is applied to the
---          variable bindings obtained, typically to create some
---          additional variable bindings.  This is applied before
---          the filter rule 'vflt'.
---
-makeN3ClosureModifyRule ::
-    Namespace -> String
-    -> String -> String -> RDFVarBindingModify -> RDFVarBindingModify
-    -> RDFRule
-makeN3ClosureModifyRule scope local ant con vflt vmod =
-    makeN3ClosureRule scope local ant con modc
-    where
-        modc  = case vbmCompose vmod vflt of
-            Just x  -> x
-            Nothing -> varBindingId
-{-
-    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc
-    where
-        antgr = makeRDFGraphFromN3String ant
-        congr = makeRDFGraphFromN3String con
-        modc  = case vbmCompose vmod vflt of
-            Just x  -> x
-            Nothing -> varBindingId
--}
-
--- |Construct an RDF graph closure rule with a bnode allocator.
---
---  This function is rather like makeN3ClosureModifyRule, except that
---  the variable binding modifier is a function from the variables in
---  the variables and bnodes contained in the antecedent graph.
---
---  scope   is a namespace tom which the rule is allocated
---  local   is a local name for the rule in the given namespace
---  ant     is a string containing the Notation3 representation
---          of the antecedent graph.  (Note: multiple antecedents
---          can be handled by combining multiple graphs.)
---  con     is a string containing the Notation3 representation
---          of the consequent graph.
---  vflt    is a variable binding modifier value that may impose
---          additional conditions on the variable bindings that
---          can be used for this inference rule.
---  aloc    is a function applied to a list of nodes to yield a
---          variable binding modifier value.
---          The supplied parameter is applied to a list of all of
---          the variable nodes (including all blank nodes) in the
---          antecedent graph, and then composed with the 'vflt'
---          value (above).  This allows any node allocation
---          function to avoid allocating any blank nodes that
---          are already used in the antecedent graph.
---          (See function makeNodeAllocTo).
---
-makeN3ClosureAllocatorRule ::
-    Namespace -> String
-    -> String -> String
-    -> RDFVarBindingModify -> ( [RDFLabel] -> RDFVarBindingModify )
-    -> RDFRule
-makeN3ClosureAllocatorRule scope local ant con vflt aloc =
-    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc
-    where
-        antgr = makeRDFGraphFromN3String ant
-        congr = makeRDFGraphFromN3String con
-        vmod  = aloc (allLabels labelIsVar antgr)
-        modc  = case vbmCompose vmod vflt of
-            Just x  -> x
-            Nothing -> varBindingId
-
-
-------------------------------------------------------------
---  Query binding modifier for "allocated to" logic
-------------------------------------------------------------
-
--- |This function defines a variable binding mofifier that
---  allocates a new blank node for each value bound to
---  a query variable, and binds it to another variable
---  in each query binding.
---
---  This provides a single binding for query variables that would
---  otherwise be unbound by a query.  For example, consider the
---  inference pattern:
---    ?a hasUncle ?c => ?a hasFather ?b . ?b hasBrother ?c .
---  For a given ?a and ?c, there is insufficient information
---  here to instantiate a value for variable ?b.  Using this
---  function as part of a graph instance closure rule allows
---  forward chaining to allocate a single bnode for each
---  occurrence of ?a, so that given:
---    Jimmy hasUncle Fred .
---    Jimmy hasUncle Bob .
---  leads to exactly one bnode inference of:
---    Jimmy hasFather _:f .
---  giving:
---    Jimmy hasFather _:f .
---    _:f hasBrother Fred .
---    _:f hasBrother Bob .
---  rather than:
---    Jimmy hasFather _:f1 .
---    _:f1 hasBrother Fred .
---    Jimmy hasFather _:f2 .
---    _:f2 hasBrother Bob .
---
---  This form of constrained allocation of bnodes is also required for
---  some of the inference patterns described by the RDF formal semantics,
---  particularly those where bnodes are substituted for URIs or literals.
---
---  bindvar is a variable node to which a new blank node is bound
---  alocvar is a variable which is bound in each query to a graph
---          node to which new blank nodes are allocated.
---
-makeNodeAllocTo ::
-    RDFLabel -> RDFLabel
-    -> [RDFLabel] -> RDFVarBindingModify
-makeNodeAllocTo bindvar alocvar exbnode = VarBindingModify
-        { vbmName   = swishName "makeNodeAllocTo"
-        , vbmApply  = applyNodeAllocTo bindvar alocvar exbnode
-        , vbmVocab  = [alocvar,bindvar]
-        , vbmUsage  = [[bindvar]]
-        }
-
---  Auxiliary function that performs the node allocation defined
---  by makeNodeAllocTo.
---
---  bindvar is a variable node to which a new blank node is bound
---  alocvar is a variable which is bound in each query to a graph
---          node to which new blank nodes are allocated.
---  exbnode is a list of existing blank nodes, to be avoided by
---          the new blank node allocator.
---  vars    is a list of variable bindings to which new bnode
---          allocations for the indicated bindvar are to be added.
---
-applyNodeAllocTo ::
-    RDFLabel -> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]
-applyNodeAllocTo bindvar alocvar exbnode vars =
-    let
-        app vbind = applyVarBinding vbind
-        alocnodes = zip (nub $ flist (map app vars) alocvar)
-                        (newNodes (makeBlank bindvar) exbnode)
-        newvb var = joinVarBindings
-            ( makeVarBinding $ head
-              [ [(bindvar,b)] | (v,b) <- alocnodes, app var alocvar == v ] )
-            var
-    in
-        map newvb vars
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFRuleset.hs,v $
--- $Author: graham $
--- $Revision: 1.20 $
--- $Log: RDFRuleset.hs,v $
--- Revision 1.20  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.19  2003/12/20 12:53:40  graham
--- Fix up code to compile and test with GHC 5.04.3
---
--- Revision 1.18  2003/12/20 12:00:14  graham
--- Introduced new TraceHelpers module for Hugs-2003 compatibility.
---
--- Revision 1.17  2003/12/19 21:01:25  graham
--- Change Debug.Trace import (from Hugs.Trace)
---
--- Revision 1.16  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.15  2003/12/16 07:05:37  graham
--- Working on updated RDFProofContext
---
--- Revision 1.14  2003/12/11 19:10:29  graham
--- Forward chaining now adds antecedent graphs rather than merging them,
--- so that
--- bnodes carried over from the original input are not separated.
--- Future developments should provide controlled scoping for bnodes,
--- to avoid
--- errors this may cause.
---
--- Revision 1.13  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.12  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.11  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.10  2003/11/25 23:02:17  graham
--- Reworked datatype variable modifier logic.
--- Limited range of test cases so far all pass.
---
--- Revision 1.9  2003/11/14 21:48:35  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.8  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.7  2003/11/06 17:58:33  graham
--- About to rework Datatype to better support class-based reasoning.
---
--- Revision 1.6  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.5  2003/10/09 17:16:13  graham
--- Added test cases to exercise features of rules used to capture
--- RDF semantics.  Also added proof test case using XML literal.
---
--- Revision 1.4  2003/10/09 13:58:59  graham
--- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
--- of using just QueryBindingModifier.
---
--- Revision 1.3  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.2  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.1  2003/09/30 16:38:19  graham
--- Add Ruleset and RDFRuleset modules to provide proof context elements
---
− Swish/HaskellRDF/RDFRulesetTest.hs 
@@ -1,470 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFRulesetTest.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFRulesetTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for ruleset data.
---
---  Note that the proof-related methods defined in RDFRuleset are tested
---  by RDFProofTest and/or RDFProofCheck.
---
-{--------+---------+---------+---------+---------+---------+---------+---------}
-
---   WNH RIP OUTmodule Swish.HaskellRDF.RDFRulesetTest where
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
-    , nullRDFFormula
-    , GraphClosure(..), makeGraphClosureRule
-    , makeRDFGraphFromN3String
-    , makeRDFFormula
-    , makeN3ClosureAllocatorRule
-    , makeN3ClosureRule
-    , makeN3ClosureSimpleRule
-    , makeNodeAllocTo
-    -- for debugging
-    , graphClosureFwdApply, graphClosureBwdApply
-    )
-
-import Swish.HaskellRDF.RDFQuery
-    ( rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding
-    , RDFVarBindingModify
-    , RDFVarBindingFilter
-    , rdfVarBindingUriRef, rdfVarBindingBlank
-    , rdfVarBindingLiteral
-    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
-    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
-    , rdfVarBindingMemberProp
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( Label (..), RDFLabel(..), RDFGraph
-    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
-    , allLabels, allNodes, remapLabels, remapLabelList
-    , toRDFGraph, emptyRDFGraph
-    , Label (..), Arc(..), arc, arcSubj, arcPred, arcObj, Selector
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..), nullVarBinding
-    , makeVarBinding
-    , vbmCompatibility, vbmCompose
-    , makeVarFilterModify
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( Ruleset(..)
-    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules
-    , getRulesetAxiom, getRulesetRule
-    , getContextAxiom, getContextRule, getMaybeContextRule )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..)
-    , fwdCheckInference
-    , showsFormula, showsFormulae, showsWidth )
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI
-    , makeScopedName
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( namespaceRDF
-    , namespaceRDFO
-    , namespaceOWL
-    , scopeRDF
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..) )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Data.List
-    ( nub, sort )
-
-import Data.Maybe
-    ( isJust, fromJust )
-
-------------------------------------------------------------
---  Test case helpers
-------------------------------------------------------------
-
-test :: String -> Bool -> Test
-test lab bv =
-    TestCase ( assertBool ("test:"++lab) bv )
-
-testVal :: (Eq a, Show a) => String -> a -> a -> Test
-testVal lab a1 a2 =
-    TestCase ( assertEqual ("testVal:"++lab) a1 a2 )
-
-testEq :: (Eq a, Show a) => String -> Bool -> a -> a -> Test
-testEq lab eq a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) eq (a1==a2) )
-
-testEqual :: (Eq a, Show a) => String -> a -> a -> Test
-testEqual lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
-testLe lab eq a1 a2 =
-    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
-
-testStringEq :: String -> String -> String -> Test
-testStringEq lab s1 s2 =
-    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )
-
-testSameNamespace :: String -> Namespace -> Namespace -> Test
-testSameNamespace lab n1 n2 =
-    TestCase ( assertBool ("testSameNamespace:"++lab) ((p1==p2)&&(u1==u2)) )
-    where
-        p1 = nsPrefix n1
-        p2 = nsPrefix n2
-        u1 = nsURI n1
-        u2 = nsURI n2
-
-testScopedNameEq :: String -> Bool -> ScopedName -> ScopedName -> Test
-testScopedNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testScopedNameEq:"++lab) eq (n1==n2) )
-
-{-
-testQNameEq :: String -> Bool -> QName -> QName -> Test
-testQNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )
--}
-
-testSameAxioms :: String -> [RDFFormula] -> [RDFFormula] -> Test
-testSameAxioms lab as1 as2 =
-    TestCase ( assertBool ("testSameAxioms:"++lab) sameas )
-    where
-        sameas = (sort as1) == (sort as2)
-
-testSameRules :: String -> [RDFRule] -> [RDFRule] -> Test
-testSameRules lab rs1 rs2 =
-    TestCase ( assertBool ("testSameRules:"++lab) samers )
-    where
-        samers = (sort rs1) == (sort rs2)
-
-------------------------------------------------------------
---  Common values
-------------------------------------------------------------
-
-pref_rdf = nsURI namespaceRDF
-pref_op  = nsURI namespaceRDFO
-pref_owl = nsURI namespaceOWL
-
-------------------------------------------------------------
---  Define and manipulate rulesets
-------------------------------------------------------------
---
---  A ruleset is essentially a collection of axioms and rules
---  associated with a namespace.
---
---  Rulesets for RDF, RDFS and basic datatyping are predefined:
---  see RDFRuleset, RDFSRuleset and RDFDRuleset.
---  Additional rulesets may be defined for specific datatypes.
---
---  A proof context is a list of rulesets,
---  which may be cited by a proof.
-
-rn1  = Namespace "r1" "http://id.ninebynine.org/wip/2003/rulesettest/r1"
-
--- Common prefix declarations for graph expressions
-pref =
-    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++
-    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++
-    "@prefix ex:   <http://example.org/> . \n" ++
-    " \n"
-
-a11  = makeRDFFormula rn1 "a11" (pref++"ex:R1 rdf:type ex:C1 .")
-a12  = makeRDFFormula rn1 "a12" (pref++"ex:R2 rdf:type ex:C2 .")
-
-r11  = makeN3ClosureSimpleRule rn1 "r11"
-            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
-            ( pref++"?r1 ex:P1 ?r2 ." )
-
-r12  = makeN3ClosureSimpleRule rn1 "r12"
-            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
-            ( pref++"?r2 ex:P2 ?r1 ." )
-
---  Basic formula and rule comparison tests
---  (tests support code added in module Proof.hs)
-
-testCmpAX01 = testEq "testCmpAX01" True  a11 a11
-testCmpAX02 = testEq "testCmpAX02" False a11 a12
-testCmpAX03 = testLe "testCmpAX03" True  a11 a11
-testCmpAX04 = testLe "testCmpAX04" True  a11 a12
-testCmpAX05 = testLe "testCmpAX05" False a12 a11
-
-testFormulaSuite = TestList
-    [ testCmpAX01, testCmpAX02, testCmpAX03, testCmpAX04, testCmpAX05
-    ]
-
-testCmpRU01 = testEq "testCmpRU01" True  r11 r11
-testCmpRU02 = testEq "testCmpRU02" False r11 r12
-testCmpRU03 = testLe "testCmpRU03" True  r11 r11
-testCmpRU04 = testLe "testCmpRU04" True  r11 r12
-testCmpRU05 = testLe "testCmpRU05" False r12 r11
-
-testRuleSuite = TestList
-    [ testCmpRU01, testCmpRU02, testCmpRU03, testCmpRU04, testCmpRU05
-    ]
-
---  Test simple ruleset construction and access
-
-a1s  = [ a11, a12 ]
-
-r1s  = [ r11, r12 ]
-
-r1   = makeRuleset rn1 a1s r1s
-
-testNS01  = testSameNamespace "testNS01" rn1 (getRulesetNamespace r1)
-testAX01  = testSameAxioms    "testAX01" a1s (getRulesetAxioms r1)
-testRU01  = testSameRules     "testRU01" r1s (getRulesetRules r1)
-
-testGeta11 = testEqual "testGeta11" (Just a11) $
-    getRulesetAxiom (ScopedName rn1 "a11") r1
-testGeta12 = testEqual "testGeta11" (Just a12) $
-    getRulesetAxiom (ScopedName rn1 "a12") r1
-testGetr11 = testEqual "testGetr11" (Just r11) $
-    getRulesetRule (ScopedName rn1 "r11") r1
-testGetr12 = testEqual "testGetr12" (Just r12) $
-    getRulesetRule (ScopedName rn1 "r12") r1
-testGetnone = testEqual "testGetnone" Nothing $
-    getRulesetRule (ScopedName rn1 "none") r1
-
-testRulesetSuite = TestList
-    [ testNS01, testAX01, testRU01
-    , testGeta11, testGeta12
-    , testGetr11, testGetr12
-    , testGetnone
-    ]
-
-------------------------------------------------------------
---  Component tests for RDF proof context
-------------------------------------------------------------
-
-prefix =
-    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++
-    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++
-    "@prefix ex:   <http://example.org/> . \n" ++
-    " \n"
-
-scopeex   = Namespace "ex"   "http://id.ninebynine.org/wip/2003/RDFProofCheck#"
-
-makeFormula :: Namespace -> String -> String -> RDFFormula
-makeFormula scope local gr =
-    makeRDFFormula scope local (prefix++gr)
-
-allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify
-allocateTo bv av = makeNodeAllocTo (vn bv) (vn av)
-    where
-        vn ('?':n) = Var n
-
-isXMLLit     ('?':x) = rdfVarBindingXMLLiteral     (Var x)
-
-queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]
-queryBack qas tg = rdfQueryBack (toRDFGraph qas) tg
-
--- Backward chaining rdf:r2
-
-rdfr2ant  = makeRDFGraphFromN3String "?x  ?a ?l . "
-rdfr2con  = makeRDFGraphFromN3String "?x  ?a ?b . ?b rdf:type rdf:XMLLiteral ."
-rdfr2modv = (allocateTo "?b" "?l") (allLabels labelIsVar rdfr2ant)
-rdfr2modc = vbmCompose (makeVarFilterModify $ isXMLLit "?l") rdfr2modv
-
-testRDF01 = test    "testRDF01" $ isJust rdfr2modc
-
-rdfr2grc = GraphClosure
-            { nameGraphRule = ScopedName scopeRDF "r2"
-            , ruleAnt       = getArcs rdfr2ant
-            , ruleCon       = getArcs rdfr2con
-            , ruleModify    = fromJust rdfr2modc
-            }
-
-rdfr2rul = Rule
-            { ruleName       = nameGraphRule rdfr2grc
-            , fwdApply       = graphClosureFwdApply rdfr2grc
-            , bwdApply       = graphClosureBwdApply rdfr2grc
-            , checkInference = fwdCheckInference rdfr2rul
-            }
-
-con03  = formExpr $ makeFormula scopeex "con03" $
-    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++
-    "_:l1 rdf:type rdf:XMLLiteral ." ++
-    "_:l2 rdf:type rdf:XMLLiteral ."
-
-v_a   = Var "a"
-v_b   = Var "b"
-v_x   = Var "x"
-u_s   = Res (makeScopedName "" "http://example.org/" "s")
-u_p1  = Res (makeScopedName "" "http://example.org/" "p1")
-u_p2a = Res (makeScopedName "" "http://example.org/" "p2a")
-u_p2b = Res (makeScopedName "" "http://example.org/" "p2b")
-u_rt  = Res (makeScopedName "" pref_rdf "type")
-u_rx  = Res (makeScopedName "" pref_rdf "XMLLiteral")
-b_l1  = Blank "l1"
-b_l2  = Blank "l2"
-
-rdfr2v1 = queryBack (ruleCon rdfr2grc) con03
-rdfr2b1 = [ [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
-            , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
-            , makeVarBinding [ (v_b,b_l1) ]
-            , makeVarBinding [ (v_b,b_l2) ]
-            ]
-          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]
-            , makeVarBinding [ (v_b,b_l2) ]
-            ]
-          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-            , makeVarBinding [ (v_b,b_l1) ]
-            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]
-            ]
-          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
-            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]
-            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]
-            ]
-          ]
-
-rdfr2v2 = rdfQueryBackModify (ruleModify rdfr2grc) rdfr2v1
-rdfr2v3 = map nub rdfr2v2
-
-testRDF02 = testVal "testRDF02" rdfr2b1 rdfr2v1
-testRDF03 = testVal "testRDF03" [] rdfr2v2
-testRDF04 = testVal "testRDF04" [] rdfr2v3
-
-testRDF09 = testEq "testRDF09" True [] $ bwdApply rdfr2rul con03
-
-testRDFSuite = TestList
-    [ testRDF01, testRDF02, testRDF03, testRDF04
-    , testRDF09
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ testFormulaSuite
-  , testRuleSuite
-  , testRulesetSuite
-  , testRDFSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFRulesetTest.hs,v $
--- $Author: graham $
--- $Revision: 1.12 $
--- $Log: RDFRulesetTest.hs,v $
--- Revision 1.12  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.11  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.10  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.9  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.8  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.7  2003/11/24 15:46:04  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.6  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.5  2003/10/22 16:18:37  graham
--- Move common namespace definitions into Namespace module
--- (May later move these into separate modules.)
---
--- Revision 1.4  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.3  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.2  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.1  2003/09/30 16:38:19  graham
--- Add Ruleset and RDFRuleset modules to provide proof context elements
---
− Swish/HaskellRDF/RDFVarBinding.hs 
@@ -1,211 +0,0 @@---------------------------------------------------------------------------------
---  $Id: RDFVarBinding.hs,v 1.4 2003/12/18 18:27:47 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  RDFVarBinding
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module instantiates the VarBinding types and methods for use
---  with RDF graph labels.
---
---  See module RDFQueryTest for test cases.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBinding, nullRDFVarBinding
-    , RDFVarBindingModify, RDFOpenVarBindingModify, RDFOpenVarBindingModifyMap
-    , RDFVarBindingFilter
-    , rdfVarBindingUriRef, rdfVarBindingBlank
-    , rdfVarBindingLiteral
-    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
-    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
-    , rdfVarBindingMemberProp
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFLabel(..)
-    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
-    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..), nullVarBinding
-    , boundVars, subBinding, makeVarBinding
-    , applyVarBinding, joinVarBindings
-    , VarBindingModify(..), OpenVarBindingModify
-    , vbmCompatibility, vbmCompose
-    , findCompositions, findComposition
-    , VarBindingFilter(..)
-    , makeVarFilterModify
-    , makeVarTestFilter, makeVarCompareFilter
-    , varBindingId, varFilterDisjunction, varFilterConjunction
-    , varFilterEQ, varFilterNE
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupMap(..) )
-
-------------------------------------------------------------
---  Types for RDF query variable bindings and modifiers
-------------------------------------------------------------
-
--- |RDFVarBinding is the specific type type of a variable
---  binding value used with RDF graph queries, returned by
---  'RDFVarBindingFind' and used by 'RDFVarBindingSubs'
-type RDFVarBinding  = VarBinding RDFLabel RDFLabel
-
--- |nullRDFVarBinding:  maps no query variables.
-nullRDFVarBinding :: RDFVarBinding
-nullRDFVarBinding = nullVarBinding
-
--- |Define type of query binding modifier for RDF graph inference
-type RDFVarBindingModify = VarBindingModify RDFLabel RDFLabel
-
--- |Open variable binding modifier that operates on RDFLabel values
---
---  RDFOpenVarBindingModify = [RDFLabel] -> RDFVarBindingModify
---
-type RDFOpenVarBindingModify = OpenVarBindingModify RDFLabel RDFLabel
-
--- |Define type for lookup map of open query binding modifiers
-type RDFOpenVarBindingModifyMap = LookupMap RDFOpenVarBindingModify
-
--- |RDFVarBindingFilter is a function type that tests to see if
---  a query binding satisfies some criterion, and is used to
---  create a variable binding modifier that simply filers
---  given variable bindings.
---
---  Queries often want to apply some kind of filter or condition
---  to the variable bindings that are processed.  In inference rules,
---  it sometimes seems desirable to stipulate additional conditions on
---  the things that are matched.
---
---  This function type is used to perform such tests.
---  A number of simple implementations are included below.
---
-type RDFVarBindingFilter = VarBindingFilter RDFLabel RDFLabel
-
-------------------------------------------------------------
---  Declare some query binding filters
-------------------------------------------------------------
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to a URI reference.
-rdfVarBindingUriRef :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingUriRef =
-    makeVarTestFilter (swishName "rdfVarBindingUriRef") isUri
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to a blank node.
-rdfVarBindingBlank :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingBlank =
-    makeVarTestFilter (swishName "rdfVarBindingBlank") isBlank
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to a literal value.
-rdfVarBindingLiteral :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingLiteral =
-    makeVarTestFilter (swishName "rdfVarBindingLiteral") isLiteral
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to an untyped literal value.
-rdfVarBindingUntypedLiteral :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingUntypedLiteral =
-    makeVarTestFilter (swishName "rdfVarBindingUntypedLiteral") isUntypedLiteral
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to a typed literal value.
-rdfVarBindingTypedLiteral :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingTypedLiteral =
-    makeVarTestFilter (swishName "rdfVarBindingTypedLiteral") isTypedLiteral
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to an XML literal value.
-rdfVarBindingXMLLiteral :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingXMLLiteral =
-    makeVarTestFilter (swishName "rdfVarBindingXMLLiteral") isXMLLiteral
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to container membership property.
-rdfVarBindingMemberProp :: RDFLabel -> RDFVarBindingFilter
-rdfVarBindingMemberProp =
-    makeVarTestFilter (swishName "rdfVarBindingMemberProp") isMemberProp
-
--- |This function generates a query binding filter that ensures
---  an indicated variable is bound to a literal value with a
---  datatype whose URI is bound to another node
---
---  dvar    a variable bound to the required datatype.
---  lvar    a variable bound to the literal node to be tested.
---
-rdfVarBindingDatatyped :: RDFLabel -> RDFLabel -> RDFVarBindingFilter
-rdfVarBindingDatatyped dvar lvar = VarBindingFilter
-    { vbfName   = swishName "rdfVarBindingDatatyped"
-    , vbfVocab  = [dvar,lvar]
-    , vbfTest   = \vb -> testDatatyped vb dvar lvar
-    }
-
-testDatatyped :: RDFVarBinding -> RDFLabel -> RDFLabel -> Bool
-testDatatyped vb dvar lvar = and $
-        [ isUri dtype
-        , isDatatyped dqnam $ applyVarBinding vb lvar
-        ]
-        where
-            dtype = applyVarBinding vb dvar
-            -- NOTE: dqnam is not evaluated unless (isUri dtype)
-            dqnam = case dtype of { (Res dqnam) -> dqnam }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/RDFVarBinding.hs,v $
--- $Author: graham $
--- $Revision: 1.4 $
--- $Log: RDFVarBinding.hs,v $
--- Revision 1.4  2003/12/18 18:27:47  graham
--- Datatyped literal inferences all working
--- (except equivalent literals with different datatypes)
---
--- Revision 1.3  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.2  2003/12/08 17:29:19  graham
--- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
---
--- Revision 1.1  2003/11/14 16:01:30  graham
--- Separate RDFVarBinding from module RDFQuery.
---
− Swish/HaskellRDF/Rule.hs 
@@ -1,265 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}----------------------------------------------------------------------------------
------  $Id: Rule.hs,v 1.8 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Rule
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a framework for defining inference rules
---  over some expression form.  It is intended to be used with
---  RDF graphs, but the structures aim to be quite generic with
---  respect to the expression forms allowed.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..), RuleMap
-    , nullScope, nullFormula, nullRule
-    , fwdCheckInference, bwdCheckInference
-    , showsFormula, showsFormulae, showsWidth
-    )
-where
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    )
-
-import Swish.HaskellUtils.ShowM
-    ( ShowM(..), showm )
-
-import Swish.HaskellUtils.ListHelpers
-    ( subset )
-
-{- in Prelude????-import List
-    ( union, intersect )
-
-import Maybe
-    ( isJust, fromJust )
--}-
-------------------------------------------------------------
---  Expressions
-------------------------------------------------------------
-
--- |Expression is a type class for values over which proofs
---  may be constructed.
-class (Eq ex) => Expression ex where
-    -- |Is expression true in all interpretations?
-    --  If so, then its truth is assumed without justification.
-    isValid :: ex -> Bool
-
-------------------------------------------------------------
---  Formula:  a named expression
-------------------------------------------------------------
-
--- |A Formula is a named expression.
-data Formula ex = Formula
-    { formName :: ScopedName        -- ^ Name used for formula in proof chain
-    , formExpr :: ex                -- ^ Named formula value
-    } deriving Show
-
--- |Define equality of formulae as equality of formula names
-instance Eq (Formula ex) where
-    f1 == f2 = formName f1 == formName f2
-
--- |Define ordering of formulae based on formula names
-instance Ord (Formula ex) where
-    f1 <= f2 = formName f1 <= formName f2
-
-instance LookupEntryClass (Formula ex) ScopedName (Formula ex)
-    where
-    newEntry (_,form) = form
-    keyVal form = (formName form, form)
-
-nullScope :: Namespace
-nullScope = Namespace "null" "http://id.ninebynine.org/2003/Ruleset/null"
-
-nullFormula :: Formula ex
-nullFormula = Formula
-    { formName = ScopedName nullScope "nullFormula"
-    , formExpr = error "Null formula"
-    }
-
--- testf1 = Formula "f1" ('f',1)
--- testf2 = Formula "f2" ('f',2)
-
--- |showsFormulae
---  Return a displayable form of a list of labelled formulae
-showsFormulae :: (ShowM ex) => String -> [Formula ex] -> String -> ShowS
-showsFormulae _       []     _     = id
-showsFormulae newline [f]    after = showsFormula  newline f .
-                                     showString    after
-showsFormulae newline (f:fs) after = showsFormula  newline f .
-                                     showString    newline .
-                                     showsFormulae newline fs after
-
--- |showsFormula
---  Create a displayable form of a labelled formula
-showsFormula :: (ShowM ex) => String -> Formula ex -> ShowS
-showsFormula newline f =
-    showsWidth 16 ("["++show (formName f)++"] ") .
-    showms (newline++(replicate 16 ' ')) (formExpr f)
-
-------------------------------------------------------------
---  Rule
-------------------------------------------------------------
-
--- |Rule is a data type for inference rules that can be used
---  to construct a step in a proof.
-data Rule ex = Rule
-    -- |Name of rule, for use when displaying a proof
-    { ruleName :: ScopedName
-    -- |Forward application of a rule, takes a list of
-    --  expressions and returns a list (possibly empty)
-    --  of forward applications of the rule to combinations
-    --  of the antecedent expressions.
-    --  Note that all of the results returned can be assumed to
-    --  be (simultaneously) true, given the antecedents provided.
-    , fwdApply :: [ex] -> [ex]
-    -- |Backward application of a rule, takes an expression
-    --  and returns a list of alternative antecedents, each of
-    --  which is a list of expressions that jointly yield the
-    --  given consequence through application of the inference
-    --  rule.  An empty list is returned if no antecedents
-    --  will allow the consequence to be inferred.
-    , bwdApply :: ex -> [[ex]]
-    -- |Inference check.  Takes a list of antecedent expressions
-    --  and a consequent expression, returning True if the
-    --  consequence can be obtained from the antecedents by
-    --  application of the rule.  When the antecedents and
-    --  consequent are both given, this is generally more efficient
-    --  that using either forward or backward chaining.
-    --  Also, a particular rule may not fully support either
-    --  forward or backward chaining, but all rules are required
-    --  to fully support this function.
-    --
-    --  A default implementation based on forward chaining is
-    --  given below.
-    , checkInference :: [ex] -> ex -> Bool
-    }
-
--- |Define equality of rules as equality of rule names
-instance Eq (Rule ex) where
-    r1 == r2 = ruleName r1 == ruleName r2
-
--- |Define ordering of rules based on rule names
-instance Ord (Rule ex) where
-    r1 <= r2 = ruleName r1 <= ruleName r2
-
-instance Show (Rule ex) where
-    show rl = "Rule "++show (ruleName rl)
-
-instance LookupEntryClass (Rule ex) ScopedName (Rule ex)
-    where
-    newEntry (_,rule) = rule
-    keyVal rule = (ruleName rule, rule)
-
-type RuleMap ex = LookupMap (Rule ex)
-
-fwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool
-fwdCheckInference rule ante cons =
-    (cons `elem` fwdApply rule ante)
-
-bwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool
-bwdCheckInference rule ante cons = any checkAnts (bwdApply rule cons)
-    where
-        checkAnts = all (`elem` ante)
-
-nullRule :: Rule ex
-nullRule = Rule
-    { ruleName = ScopedName nullScope "nullRule"
-    , fwdApply = \ _ -> []
-    , bwdApply = \ _ -> []
-    , checkInference = \ _ _ -> False
-    }
-
-------------------------------------------------------------
---  Shows formatting support functions
------------------------------------------------------------
-
--- |Show a string left justified in a field of at least the specified
---  number of characters width.
-showsWidth :: Int -> String -> ShowS
-showsWidth wid str more = str++replicate pad ' '++more
-    where
-        pad = wid - length str
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Rule.hs,v $
--- $Author: graham $
--- $Revision: 1.8 $
--- $Log: Rule.hs,v $
--- Revision 1.8  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.7  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.6  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.5  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.4  2003/11/06 17:58:33  graham
--- About to rework Datatype to better support class-based reasoning.
---
--- Revision 1.3  2003/10/24 21:05:09  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.2  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.1  2003/09/30 20:00:46  graham
--- Add module Rule as common dependency for Proof and Ruleset
---
− Swish/HaskellRDF/Ruleset.hs 
@@ -1,190 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}----------------------------------------------------------------------------------
---  $Id: Ruleset.hs,v 1.9 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Ruleset
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a ruleset data type, used to collect information
---  about a ruleset that may contribute torwards inferences in RDF;
---  e.g. RDF and RDFS are rulesets.
---
---  A ruleset consists of a namespace, a collection of axioms and
---  a collection of rules.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.Ruleset
-    ( Ruleset(..), RulesetMap
-    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules
-    , getRulesetAxiom, getRulesetRule
-    , getContextAxiom, getMaybeContextAxiom
-    , getContextRule,  getMaybeContextRule
-    )
-where
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI
-    , matchName )
-
-import Swish.HaskellRDF.Rule
-    ( Expression(..), Formula(..), Rule(..)
-    , fwdCheckInference
-    , showsFormula, showsFormulae, showsWidth
-    )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , mapFindMaybe
-    )
-
-import Data.Maybe
-    ( Maybe(..), isJust, fromJust, fromMaybe, listToMaybe, mapMaybe )
-
-------------------------------------------------------------
---  Ruleset, having namespace, axioms and rules
-------------------------------------------------------------
-
-data Ruleset ex = Ruleset
-    { rsNamespace :: Namespace
-    , rsAxioms    :: [Formula ex]
-    , rsRules     :: [Rule ex]
-    }
-
-instance Eq (Ruleset ex) where
-    r1 == r2 = rsNamespace r1 == rsNamespace r2
-
-instance LookupEntryClass (Ruleset ex) Namespace (Ruleset ex)
-    where
-        keyVal   r@(Ruleset k _ _) = (k,r)
-        newEntry (_,r)             = r
-
-type RulesetMap ex = LookupMap (Ruleset ex)
-
-makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
-makeRuleset nsp fms rls = Ruleset
-    { rsNamespace = nsp
-    , rsAxioms    = fms
-    , rsRules     = rls
-    }
-
-getRulesetNamespace :: Ruleset ex -> Namespace
-getRulesetNamespace = rsNamespace
-
-getRulesetAxioms :: Ruleset ex -> [Formula ex]
-getRulesetAxioms = rsAxioms
-
-getRulesetRules :: Ruleset ex -> [Rule ex]
-getRulesetRules = rsRules
-
-------------------------------------------------------------
---  Find a named axiom or rule in a ruleset or proof context
-------------------------------------------------------------
-
-getRulesetAxiom :: ScopedName -> Ruleset ex -> Maybe (Formula ex)
-getRulesetAxiom nam rset =
-    mapFindMaybe nam (LookupMap (getRulesetAxioms rset))
-    -- listToMaybe $ filter ( (matchName nam) . formName ) $ getRulesetAxioms rset
-
-getRulesetRule :: ScopedName -> Ruleset ex -> Maybe (Rule ex)
-getRulesetRule nam rset =
-    mapFindMaybe nam (LookupMap (getRulesetRules rset))
-    -- listToMaybe $ filter ( (matchName nam) . ruleName ) $ getRulesetRules rset
-
-getContextAxiom :: ScopedName -> Formula ex -> [Ruleset ex] -> Formula ex
-getContextAxiom nam def rsets = fromMaybe def (getMaybeContextAxiom nam rsets)
-    {-
-    foldr (flip fromMaybe) def $ map (getRulesetAxiom nam) rsets
-    -}
-
-getMaybeContextAxiom :: ScopedName -> [Ruleset ex] -> Maybe (Formula ex)
-getMaybeContextAxiom nam rsets =
-    listToMaybe $ mapMaybe (getRulesetAxiom nam) rsets
-
-getContextRule :: ScopedName -> Rule ex -> [Ruleset ex] -> Rule ex
-getContextRule nam def rsets = fromMaybe def (getMaybeContextRule nam rsets)
-    {-
-    foldr (flip fromMaybe) def $ map (getRulesetRule nam) rsets
-    -}
-
-getMaybeContextRule :: ScopedName -> [Ruleset ex] -> Maybe (Rule ex)
-getMaybeContextRule nam rsets =
-    listToMaybe $ mapMaybe (getRulesetRule nam) rsets
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Ruleset.hs,v $
--- $Author: graham $
--- $Revision: 1.9 $
--- $Log: Ruleset.hs,v $
--- Revision 1.9  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.8  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.7  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.6  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.5  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.4  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.3  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.2  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.1  2003/09/30 16:38:19  graham
--- Add Ruleset and RDFRuleset modules to provide proof context elements
---
− Swish/HaskellRDF/Sort/AdaptiveHeapSort.lhs 
@@ -1,37 +0,0 @@-%-------------------------------=  --------------------------------------------
-\section{Adaptive heap sort}
-%-------------------------------=  --------------------------------------------
-
-%include CartesianTree.lhs
-
-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Adaptive heap sort}
-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-
-%align
-
-> module Swish.HaskellRDF.Sort.AdaptiveHeapSort
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.CartesianTree (BinTree(..), cartesianTree)
-> import Swish.HaskellRDF.Sort.HeapSort (Heap(..), leaf, insertBy)
-> import Swish.HaskellRDF.Sort.BraunHeap (siftBy, joinBy)
-
-%align 33
-
-> adaptiveHeapSort		:: (Ord a) => [a] -> [a]
-> adaptiveHeapSort		=  adaptiveHeapSortBy (<=)
-
-> adaptiveHeapSortBy (<=) as	=  unheap (leaf (cartesianTree as))
->   where
->
->   Leaf      <== _		=  True
->   Node _ a _ <== Node _ b _	=  a <= b
->   Node _ _ _ <== _		=  False
-
->   unheap Empty		=  []
->   unheap (Bin t hl hr)	=  case t of
->       Node Leaf a Leaf	-> a : unheap (joinBy (<==) hl hr)
->       Node l a Leaf		-> a : unheap (siftBy (<==) l hl hr)
->       Node Leaf a r		-> a : unheap (siftBy (<==) r hl hr)
->       Node l a r		-> a : unheap (insertBy (<==) r $ siftBy (<==) l hl hr)
− Swish/HaskellRDF/Sort/BraunHeap.lhs 
@@ -1,91 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Braun heaps}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.BraunHeap
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.ListLib (prefold)
-> import Swish.HaskellRDF.Sort.HeapSort (Heap(..), leaf, insertBy)
-
-%align 33
-
-%-------------------------------=  --------------------------------------------
-\section{Top-down heap sort}
-%-------------------------------=  --------------------------------------------
-
-Here is a variant of heap sort due to Paulson \cite[p. 160]{Pau96ML}
-which follows the original more closely. Recall that imperative
-implementations of heap sort use an implicit representation of binary
-heaps ie the binary tree is embedded in an array. For a functional
-explanation we step backward and represent an array by a binary tree.
-The original heap sort uses left-complete trees. We use Braun
-trees~\cite[p. 154]{Pau96ML} instead. However, every implementation of
-functional arrays would do. We could generalize the following to an
-array-based implementation of priority queues.
-
-The construction of the heap works as before.  The second phase mimics
-the imperative version: the smallest element (ie the leftmost) is
-replaced by an arbitrary element (usually the rightmost) which is
-sifted down the heap. Here we replace the root (ie the leftmost) by the
-leftmost leaf (ie an element in the rear part of the array). Both
-|splitLeft| and |sift| employ the fact that their arguments are Braun
-trees.
-
-> unHeapBy			:: Rel a -> Heap a -> [a]
-> unHeapBy (<=) Empty		=  []
-> unHeapBy (<=) (Bin a l r)	=  a : unHeapBy (<=) (joinBy (<=) l r)
->
-> joinBy			:: Rel a -> Heap a -> Heap a -> Heap a
-> joinBy (<=) l r		=  case splitLeft l of
->     Null			-> Empty
->     Pair a l'			-> siftBy (<=) a r l'
->
-> splitLeft			:: Heap a -> OptPair a (Heap a)
-> splitLeft Empty		=  Null
-> splitLeft (Bin a l r)		=  case splitLeft l of
->     Null			-> Pair a Empty		-- |r == Empty|
->     Pair b l'			-> Pair b (Bin a r l')
-
-The recursion scheme is dual to that of |insert|: the element is always
-deleted into the left subtree (which is possibly bigger). Additionally,
-the left and the right branch are interchanged (in case both subtrees
-have the same size).
-
-> siftBy			:: Rel a -> a -> Heap a -> Heap a -> Heap a
-> siftBy (<=)			=  sift
->   where
->   sift a Empty r		=  leaf a		-- |r == Empty|
->   sift a l@(Bin b _ _) Empty				-- |l == leaf b|
->       | a <= b		=  Bin a l Empty
->       | otherwise		=  Bin b (leaf a) Empty
->   sift a l@(Bin a1 l1 r1) r@(Bin a2 l2 r2)
->       | a <= a1 && a <= a2	=  Bin a l r
->       | a1 <= a2		=  Bin a1 (sift a l1 r1) r
->       | otherwise		=  Bin a2 l (sift a l2 r2)
-
-We do not use the |sift| function defined in |HeapSort| because |sift|
-on Braun trees is slightly simpler. Note, however, that |sift| makes a
-redundant comparison if |a2 < a <= a1|.
-
-> braunSort			:: (Ord a) => [a] -> [a]
-> braunSort			=  braunSortBy (<=)
->
-> braunSortBy			:: Rel a -> [a] -> [a]
-> braunSortBy (<=)		=  unHeapBy (<=) . foldr (insertBy (<=)) Empty
-
-%-------------------------------=  --------------------------------------------
-\section{Bottom-up heap sort}
-%-------------------------------=  --------------------------------------------
-
-The bottom-up variant is straightforward and a true transliteration of
-Williams' heap sort apart from the fact that we use Braun trees instead
-of left-complete trees.
-
-> bottomUpBraunSort		:: (Ord a) => [a] -> [a]
-> bottomUpBraunSort		=  bottomUpBraunSortBy (<=)
->
-> bottomUpBraunSortBy		:: Rel a -> [a] -> [a]
-> bottomUpBraunSortBy (<=)	=  unHeapBy (<=) . prefold (siftBy (<=)) Empty
− Swish/HaskellRDF/Sort/CartesianTree.lhs 
@@ -1,48 +0,0 @@-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Cartesian trees}
-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-
-%align
-
-> module Swish.HaskellRDF.Sort.CartesianTree 
-> where
-
-%align 33
-
-> data BinTree a		=  Leaf
->				|  Node (BinTree a) a (BinTree a)
->				   deriving (Show)
-
-Constructing a cartesian tree in linear time.
-
-> data Spine a			=  Nil
->				|  Cons a (BinTree a) (Spine a)
-
-> up				:: BinTree a -> Spine a -> BinTree a
-> up l Nil			=  l
-> up l (Cons a r s)		=  up (Node l a r) s
-
-> cartesianTree			:: (Ord a) => [a] -> BinTree a
-> cartesianTree			=  cartesianTreeBy (<=)
->
-> cartesianTreeBy (<=)		=  up Leaf . foldr (\a s -> cons a Leaf s) Nil
->   where cons a t Nil		=  Cons a t Nil
->         cons a t s@(Cons a' t' s')
->             | a <= a'		=  cons a (Node t a' t') s'
->             | otherwise	=  Cons a t s
-
-|cartesianTree [5, 8, 2, 3, 7, 4, 10, 0]|
-
-\NB The obvious approaches (top-down and bottom-up) both lead to
-$\Theta(n\log n)$ algorithms. For curiosity here is the top-down
-variant of |meld|.
-
-> meld				:: (Ord a) => BinTree a -> BinTree a -> BinTree a
-> meld Leaf u			=  u
-> meld t Leaf			=  t
-> meld t@(Node l a r) u@(Node l' a' r')
->     | a <= a'			=  Node l a (meld r u)
->     | otherwise		=  Node (meld t l') a' r'
-
-Note that the relative order of elements is preserved. The bottom-up
-variants of cartesian trees are called \technical{pagodas}.
− Swish/HaskellRDF/Sort/DigitalSort.lhs 
@@ -1,51 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Digital sorting}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.DigitalSort -> where
-> import Data.Array
-> import Data.Bits
-> import Data.Int
-
-%align 33
-
-> bucketSort			:: (Ix b) => (b, b) -> (a -> b) -> [a] -> [a]
-> bucketSort bs key as		=  [ a | b <- elems buckets, a <- reverse b ]
->     where buckets		=  distribute bs [ (key a, a) | a <- as ]
->
-> distribute			:: (Ix a) => (a, a) -> [(a, b)] -> Array a [b]
-> distribute			=  accumArray (flip (:)) []
->
-> radixSort			:: (Ix b) => (b, b) -> [a -> b] -> [a] -> [a]
-> radixSort bs keys x		=  foldr (bucketSort bs) x keys
-
-|keys| must satisfy the following property: let $a \leq_i b
-\Longleftrightarrow |key|_i\;a \leq |key|_i\;b$ and $a(R\fatsemi S)b
-\Longleftrightarrow aRb \vee (a=b \wedge aSb)$, then $(\leq)
-\Longleftrightarrow (\leq_1)\fatsemi\ldots\fatsemi(\leq_n)$.
-
-\NB |Word| should be used instead of |Int| since the sign bit is
-ignored.
-
-> int32Keys'			:: [Int32 -> Bool]
-> int32Keys'			=  [ \i -> testBit i k | k <- [s - 1, s - 2 .. 0] ]
->     where s			=  bitSize (0 :: Int32)
->
-> int32RadixSort'		:: [Int32] -> [Int32]
-> int32RadixSort'		=  radixSort (False, True) int32Keys'
-
-|shiftR| does not work properly, that's why |32 - 24| instead of |24|
-is used below.
-
-> int32Keys			:: [Int32 -> Int32]
-> int32Keys			=  [ \i -> shiftR i (32 - 24) .&. 255
->				   , \i -> shiftR i (32 - 16) .&. 255
->				   , \i -> shiftR i (32 - 8) .&. 255
->				   , \i -> i .&. 255 ]
->
-> int32RadixSort		:: [Int32] -> [Int32]
-> int32RadixSort		=  radixSort (0, 255) int32Keys
->
− Swish/HaskellRDF/Sort/FingerSearchtree.lhs 
@@ -1,125 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Finger search trees}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.FingerSearchtree 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-
-%align 33
-
-This is work in progress \ldots
-
-> data Empty a			=  E
->
-> data Pennant tree a		=  Top a (tree a)
->
-> data Node23 tree23 a		=  N2 (tree23 a) a (tree23 a)
->				|  N3 (tree23 a) a (tree23 a) a (tree23 a) 
-
-> data FingerTree23 tree23 a	=  Nil
->				|  One (Pennant tree23 a) (FingerTree23 (Node23 tree23) a)
->				|  Two (Pennant (Node23 tree23) a) (FingerTree23 (Node23 tree23) a)
->
-> type Bag a			=  FingerTree23 Empty a
-
-> incr						:: Pennant tree23 a -> FingerTree23 tree23 a -> FingerTree23 tree23 a
-> incr p Nil					=  One p Nil
-> incr (Top a1 t1) (One (Top a2 t2) ds)		=  Two (Top a1 (N2 t1 a2 t2)) ds
-> incr (Top a1 t1) (Two (Top a2 (N2 t2 a3 t3)) ds)
->						=  Two (Top a1 (N3 t1 a2 t2 a3 t3)) ds
-> incr (Top a1 t1) (Two (Top a2 (N3 t2 a3 t3 a4 t4)) ds)
->						=  Two (Top a1 (N2 t1 a2 t2)) (incr (Top a3 (N2 t3 a4 t4)) ds)
-
-> data Grown tree23 a		=  U (tree23 a)  
->				|  G (tree23 a) a (tree23 a)
->
-> class Ins tree23 where
->     ins			:: (Ord a) => a -> tree23 a -> Grown tree23 a
-
-> instance Ins Empty where
->     ins a E			=  G E a E
->
-> instance (Ins tree23) => Ins (Node23 tree23) where
->     ins a (N2 t1 a1 t2)
->         | a <= a1		=  node2l (ins a t1) a1 t2
->         | otherwise		=  node2r t1 a1 (ins a t2)
->     ins a (N3 t1 a1 t2 a2 t3)
->         | a <= a1		=  node3l (ins a t1) a1 t2 a2 t3
->         | a <= a2		=  node3m t1 a1 (ins a t2) a2 t3
->         | otherwise		=  node3r t1 a1 t2 a2 (ins a t3)
-
-> node2l			:: Grown tree23 a -> a -> tree23 a -> Grown (Node23 tree23) a
-> node2l (U t1) a1 t2		=  U (N2 t1 a1 t2)
-> node2l (G t1 a1 t2) a2 t3	=  U (N3 t1 a1 t2 a2 t3)
-
-> node2r t1 a1 (U t2)		=  U (N2 t1 a1 t2)
-> node2r t1 a1 (G t2 a2 t3)	=  U (N3 t1 a1 t2 a2 t3)
-
-> node3l (U t1) a1 t2 a2 t3	=  U (N3 t1 a1 t2 a2 t3)
-> node3l (G t1 a1 t2)a2 t3 a3 t4=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
-
-> node3m t1 a1 (U t2) a2 t3	=  U (N3 t1 a1 t2 a2 t3)
-> node3m t1 a1 (G t2 a2 t3)a3 t4=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
->
-> node3r t1 a1 t2 a2 (U t3)	=  U (N3 t1 a1 t2 a2 t3)
-> node3r t1 a1 t2 a2(G t3 a3 t4)=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
-
-> insert'			:: (Ord a, Ins tree23) => a -> FingerTree23 tree23 a -> Maybe (FingerTree23 tree23 a)
-> insert' a Nil			=  Nothing
-> insert' a (One p@(Top a1 t1) ds)
->     | a <= a1			=  Nothing
->     | otherwise		=  case insert' a ds of
->         Nothing		-> Just (one a1 (ins a t1) ds)
->         Just ds'		-> Just (One p ds')
-> insert' a (Two p@(Top a1 t1) ds)
->     | a <= a1			=  Nothing
->     | otherwise		=  case insert' a ds of
->         Nothing		-> Just (two a1 (ins a t1) ds)
->         Just ds'		-> Just (Two p ds')
-
-> one				:: a -> Grown tree23 a -> FingerTree23 (Node23 tree23) a -> FingerTree23 tree23 a
-> one a1 (U t1) t2		=  One (Top a1 t1) t2
-> one a1 (G t1 a2 t2) t3	=  Two (Top a1 (N2 t1 a2 t2)) t3
->
-> two				:: a -> Grown (Node23 tree23) a -> FingerTree23 (Node23 tree23) a -> FingerTree23 tree23 a
-> two a1 (U t1) t2		=  Two (Top a1 t1) t2
-> two a1 (G t1 a2 t2) t3	=  Two (Top a1 t1) (incr (Top a2 t2) t3)
-
-> insert			:: (Ord a) => a -> Bag a -> Bag a
-> insert a t			=  case insert' a t of
->     Nothing			-> incr (Top a E) t
->     Just t'			-> t'
-
-> class Inord tree23 where
->     inord			:: tree23 a -> Sequ a
->
-> instance Inord Empty where
->     inord E			=  empty
->
-> instance (Inord tree23) => Inord (Node23 tree23) where
->     inord (N2 t1 a1 t2)	=  inord t1 . single a1 . inord t2
->     inord (N3 t1 a1 t2 a2 t3)	=  inord t1 . single a1 . inord t2
->				.  single a2 . inord t3
->
-> instance (Inord tree23) => Inord (Pennant tree23) where
->     inord (Top a t)		=  single a . inord t
-
-> inorder'			:: (Inord tree23) => FingerTree23 tree23 a -> Sequ a
-> inorder' Nil			=  empty
-> inorder' (One p ds)		=  inord p . inorder' ds
-> inorder' (Two p ds)		=  inord p . inorder' ds
->
-> inorder			:: Bag a -> [a]
-> inorder b			=  inorder' b []
-
-> fingerTreeSort		:: (Ord a) => [a] -> [a]
-> fingerTreeSort		=  inorder . foldr insert Nil
-
-> type Sequ a			=  [a] -> [a]
->
-> empty				=  \x -> x
->
-> single a			=  \x -> a : x
− Swish/HaskellRDF/Sort/Force.lhs 
@@ -1,27 +0,0 @@-%-------------------------------=  --------------------------------------------
-\section{Hyper-strict evaluation}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.Force 
-> where
-
-%align 33
-
-Vollst"andige Auswertung.
-
-> class Force a where
->     force			:: a -> ()
->
->     force a			=  a `seq` ()
-
-> instance Force Bool
-> instance Force Char
-> instance Force Int
-> instance Force Integer
-> instance Force Double
->
-> instance (Force a) => Force [a] where
->     force []			=  ()
->     force (a : as)		=  force a `seq` force as
− Swish/HaskellRDF/Sort/HeapSort.lhs 
@@ -1,140 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Heap sort}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.HeapSort 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.ListLib
-> import Swish.HaskellRDF.Sort.MergeSort (mergeBy)
-
-%align 33
-
-%-------------------------------=  --------------------------------------------
-\section{Top-down heap sort}
-%-------------------------------=  --------------------------------------------
-
-It appears that the functional variant of heap sort has been invented
-several times. See, for instance, \cite[p.~155]{HinFun92} or
-\cite[p.~20]{Bir96Fun}.
-
-Heap sort is based on binary heap ordered trees.
-
-> data Heap a			=  Empty
->				|  Bin a (Heap a) (Heap a)
->
-> leaf				:: a -> Heap a
-> leaf a			=  Bin a Empty Empty
-
-The top-down variant works by repeatedly inserting elements into an
-empty initial tree.
-
-> insertBy			:: Rel a -> a -> Heap a -> Heap a
-> insertBy (<=) a Empty		=  leaf a
-> insertBy (<=) a (Bin b l r)
->     | a <= b			=  Bin a (insertBy (<=) b r) l
->     | otherwise		=  Bin b (insertBy (<=) a r) l
-
-Repeated |insert|'s constructs a so-called Braun tree (|size r <= size
-l <= size r+1| holds for each |Bin l a r|). This guarantees a worst
-case running time of $O(n\log n)$ for |heapSort|. The recursion scheme
-is typical for Braun trees:  the element is always inserted into the
-right subtree (which is possibly smaller). Additionally, the left and
-the right branch are interchanged (in case both subtrees have the same
-size). This implies, however, that |heapSort| is not stable.
-
-> unHeapBy			:: Rel a -> Heap a -> [a]
-> unHeapBy (<=) Empty		=  []
-> unHeapBy (<=) (Bin a l r)	=  a : mergeBy (<=) (unHeapBy (<=) l)
->				                    (unHeapBy (<=) r)
->
-> heapSort			:: (Ord a) => [a] -> [a]
-> heapSort			=  heapSortBy (<=)
->
-> heapSortBy			:: Rel a -> [a] -> [a]
-> heapSortBy (<=)		=  unHeapBy (<=) . foldr (insertBy (<=)) Empty
-
-
-The function |unheap| resorts to |merge| which probably not in the
-spirit of the original heap sort by Williams (see also
-\cite[p.~21]{Bir96Fun} where |meld| is called combine). Instead we can
-combine the two subheaps into one.
-
-> unHeap			:: (Ord a) => Heap a -> [a]
-> unHeap Empty			=  []
-> unHeap (Bin a l r)		=  a : unHeap (meld l r)
->
-> meld				:: (Ord a) => Heap a -> Heap a -> Heap a
-> meld Empty t'			=  t'
-> meld t@(Bin _ _ _) Empty	=  t
-> meld t@(Bin a l r) t'@(Bin a' l' r')
->        | a <= a'		=  Bin a  (meld l r) t'
->        | otherwise		=  Bin a' t (meld l' r')
-
-This variant of |unHeap| also clarifies the relationship to merge
-sort. First note that |meld| is closely related to |merge|. We have
-%
-\begin{eqnarray*}
-    |toOrdList (meld t u)|
-        & = & |merge (toOrdList t) (toOrdList u)| \enskip.
-\end{eqnarray*}
-%
-Thus
-
-> heapSort'			:: (Ord a) => [a] -> [a]
-> heapSort'			=  unHeap . gfoldm Empty leaf meld
-
-is structurally equivalent to |mergeSort| (ie it performs the same
-comparisons during the sorting process). In essence, this shows that it
-is unlikely that heap sort is faster than merge sort. As a final remark
-note that |heapSort'| is stable and lazy.
-
-%-------------------------------=  --------------------------------------------
-\section{Bottom-up heap sort}
-%-------------------------------=  --------------------------------------------
-
-It is well known that a heap can be constructed in linear time.  We
-have already seen a simple method, namely |gfoldm empty leaf meld|!
-The classical solution employs a function termed |sift|. Functionally
-speaking, |sift| is a smart constructor for binary heaps, ie it
-combines an element and two heaps into a single heap.
-{\setlength{\lwidth}{\lwidth + 1cm}
-
-> siftBy			:: Rel a -> a -> Heap a -> Heap a -> Heap a
-> siftBy (<=)			=  sift
->   where
->   sift a Empty Empty		=  leaf a
->   sift a Empty r@(Bin _ _ _)	=  siftr a Empty r
->   sift a l@(Bin _ _ _) Empty	=  siftl a l Empty
->   sift a l@(Bin b _ _) r@(Bin c _ _)
->       | b <= c		=  siftl a l r
->       | otherwise		=  siftr a l r
->
->   siftl a Empty r		=  error "siftl"
->   siftl a l@(Bin b ll lr) r
->       | a <= b		=  Bin a l r
->       | otherwise		=  Bin b (sift a ll lr) r
-> 
->   siftr a l Empty		=  error "siftr"
->   siftr a l r@(Bin b rl rr)
->       | a <= b		=  Bin a l r
->       | otherwise		=  Bin b l (sift a rl rr)
-
-Note that |sift| does not change the structure of the subheaps. We
-could be more reluctant and replace |siftr| by |siftl|.  Unfortunately,
-|sift| is not stable, ie the relative order of elements is not
-preserved.}
-
-> bottomUpHeapSort		:: (Ord a) => [a] -> [a]
-> bottomUpHeapSort		=  bottomUpHeapSortBy (<=)
->
-> bottomUpHeapSortBy		:: Rel a -> [a] -> [a]
-> bottomUpHeapSortBy (<=)	=  unHeapBy (<=) . prefold (siftBy (<=)) Empty
-
-To see what |prefold| does, consider the call |prefold Bin Empty as|.
-The result is a Braun tree the preorder traversal of which yields
-|as|.  An alternative algorithm which constructs a tree whose
-\technical{level-order} traversal is equal to the original sequence is
-given in \cite[p.~22]{Bir96Fun}.
− Swish/HaskellRDF/Sort/LibBase.lhs 
@@ -1,24 +0,0 @@-%-------------------------------=  --------------------------------------------
-\section{Base functions and types}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.LibBase 
-> where
-
-%align 33
-
-> type Rel a			=  a -> a -> Bool
-
-> data OptPair a b		=  Null
->				|  Pair a b
-
-> ordered			:: (Ord a) => [a] -> Bool
-> ordered			=  orderedBy (<=)
-
-> orderedBy			:: Rel a -> [a] -> Bool
-> orderedBy (<=) []		=  True
-> orderedBy (<=) (a : as)	=  ordered a as
->   where ordered a1 []		=  True
->         ordered a1 (a2 : as)	=  a1 <= a2 && ordered a2 as
− Swish/HaskellRDF/Sort/ListLib.lhs 
@@ -1,119 +0,0 @@-%-------------------------------=  --------------------------------------------
-\section{List library}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.ListLib 
-> where
-
-%align 33
-
-> simple			:: [a] -> Bool
-> simple []			=  True
-> simple [a]			=  True
-> simple (a1 : a2 : as)		=  False
-
-> halve				:: [a] -> ([a], [a])
-> halve as			=  splitAt (length as `div` 2) as
-
-> repSplit			:: [Int] -> [a] -> [[a]]
-> repSplit ns []		=  []
-> repSplit [] xs		=  [xs]
-> repSplit (n : ns) xs		=  ys : repSplit ns zs
->   where (ys, zs)		=  splitAt n xs
-
-> copy				:: [a] -> [a]
-> copy				=  concat . repeat
-
-> interleave			:: [a] -> [a] -> [a]
-> interleave [] y		=  y
-> interleave (a:x) y		=  a : interleave y x
-
-> uninterleave			:: [a] -> ([a], [a])
-> uninterleave []		=  ([], [])
-> uninterleave [a]		=  ([a], [])
-> uninterleave (a1 : a2 : as)	=  (a1 : odds, a2 : evens)
->     where (odds, evens)	=  uninterleave as
-
-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-\subsection{folds}
-%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
-
-Here is yet another colleague of |foldr| and |foldl|: |foldm|
-constructs a balanced expression tree.
-
-> foldm				:: (a -> a -> a) -> a -> [a] -> a
-> foldm (*) e []		=  e
-> foldm (*) e x			=  fst (rec (length x) x)
->     where rec 1 (a:x)		=  (a, x)
->           rec n x		=  (a * b, z)
->               where m		=  n `div` 2
->                     (a, y)	=  rec (n - m) x 
->                     (b, z)	=  rec m       y
-
-> gfoldm			:: a -> (b -> a) -> (a -> a -> a) -> [b] -> a
-> gfoldm e f (*) []		=  e
-> gfoldm e f (*) x		=  fst (rec (length x) x)
->     where rec 1 (a:x)		=  (f a, x)
->           rec n x		=  (a * b, z)
->               where m		=  n `div` 2
->                     (a, y)	=  rec (n - m) x 
->                     (b, z)	=  rec m       y
-
-Jon's |treefold|. In a sense |foldm| works top-down and |treefold|
-works bottom-up.
-
-> treefold			:: (a -> a -> a) -> a -> [a] -> a
-> treefold (*) e []		=  e
-> treefold (*) e [a]		=  a
-> treefold (*) e (a:b:x)	=  treefold (*) e (a * b : pairfold (*) x)
-
-> pairfold			:: (a -> a -> a) -> [a] -> [a]
-> pairfold (*) (a:b:x)		=  a * b : pairfold (*) x
-> pairfold (*) x		=  x -- here |x| will have fewer than two 
-
-Note that |foldm| and |treefold| construct different trees: |foldm|
-returns a Braun tree while |treefold| returns a tree of the form
-\[	
-    |t1 * (t2 * (.. (tn-1 * tn) ..))|
-\]
-where the |ti|'s are complete binary trees in decreasing size. The size
-of the trees corresponds to the binary decomposition of the input
-length.
-
-"`Inverse"' Funktion zum Preorder-Durchlauf.
-
-> prefold			:: (a -> b -> b -> b) -> b -> [a] -> b
-> prefold f e as		=  fst (rec (length as) as)
->     where rec 0 as		=  (e, as)
->           rec (n + 1) []	=  error "rec"
->           rec (n + 1) (a : as)=  (f a l r, as2)
->               where m		=  n `div` 2
->                     (l, as1)	=  rec (n - m) as
->                     (r, as2)	=  rec m       as1
-
-> perms				:: [a] -> [[a]]
-> perms []			=  [ [] ]
-> perms (a:x)			=  [ z | y <- perms x, z <- insertions a y ]
->
-> insertions			:: a -> [a] -> [[a]]
-> insertions a []		=  [ [a] ]
-> insertions a x@(b:y)		=  (a:x) : [ b:z | z <- insertions a y ]
-
-> spaces			:: Int -> [Char]
-> spaces n			=  replicate (max n 0) ' '
-
-> cjustify, ljustify, rjustify	:: Int -> String -> String
-> cjustify                      =  cjustifyWith ' '
-> ljustify n s			=  s ++ spaces (n - length s)
-> rjustify n s			=  spaces (n - length s) ++ s
-
-> indent			:: Int -> String -> String
-> indent n s			=  spaces n ++ s
-
-> cjustifyWith			:: a -> Int -> [a] -> [a]
-> cjustifyWith c n s            =  replicate l c ++ s ++ replicate r c
->     where m                   =  n - length s
->           l                   =  m `div` 2
->           r                   =  m - l
− Swish/HaskellRDF/Sort/MargeSort.lhs 
@@ -1,576 +0,0 @@-%if codeOnly
-
-> module Swish.HaskellRDF.Sort.MargeSort (margeSort, naturalMargeSort)
-> where
-> import Swish.HaskellRDF.Sort.MergeSort (upDownRunsBy)
->
-> data OptPair a b		=  NoPair | Pair a b
->
-> data Empty a			=  E
->
-> data Node23 tree a		=  N2 (tree a) a (tree a)
->				|  N3 (tree a) a (tree a) a (tree a)
->
-> type FST1			=  FingerSearchTree1
->
-> type OS			=  OrdSequence
->
-> data Grown tree a		=  U (tree a)  
->				|  G (tree a) a (tree a)
-
-%endif
-%format Cons (a) (t)		=  a "\triangleleft " t
-%format Snoc (t) (a)		=  t "\triangleright " a
-%-------------------------------=  --------------------------------------------
-\section{Double-ended Finger Search Trees}
-\label{sec:fstvariations}
-%-------------------------------=  --------------------------------------------
-
-\Todo{Min-Max-Heaps}. The datatype |FST| implements one-sided ordered
-sequences.  In order to support operations on both ends --- |snoc =
-addMax| and |rear = splitMax| in addition to |cons = AddMin| and |front
-= splitMin| --- we must base finger search trees on the symmetric spine
-view of 2-3 trees. Here are the necessary type definitions.
-%align 9
-%{
-%format S2			=  Simple2
-%format S3			=  Simple3
-%format C			=  Composite
-
-> data FingerSearchTree1 tree a
->	=  S2 a
->	|  S3 a (tree a) a
->	|  C (Digit Front tree a)
->            (FingerSearchTree1 (Node23 tree) a)
->            (Digit Rear tree a)
->
-> data Digit pennant tree a
->	=  One (pennant tree a)
->	|  Two (pennant (Node23 tree) a)
-
-%}
-%align 33
-
-> data Front tree a		=  Cons a (tree a)
->
-> data Rear tree a		=  Snoc (tree a) a
->
-> data OrdSequence a		=  Nil | Id (FingerSearchTree1 Empty a)
-
-Two points are worth mentioning. First of all, |FST1| is not capable of
-representing the empty sequence. For that reason we have introduced the
-wrapper datatype |OS| (see also Section~\ref{sec:external}). Second, we
-use different types of pennants for the digits on the left and for
-those on the right spine view. The types have been chosen so that the
-order of elements within an expression reflects the order of elements
-within the sequence represented.
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Deque operations}
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-
-The deque operations, |cons|, |incr|, |splitMin|, |zero| and their
-colleagues |snoc|, |rcni|, |splitMax|, |eroz|, can be easily adapted to
-the new design. Here, we show the modified versions of |cons| and
-|incr| only.
-%{
-%format One			=  O
-%format Two			=  T
-%align 41
-
-> cons					:: a -> OrdSequence a -> OrdSequence a
-> cons a Nil				=  Id (S2 a)
-> cons a (Id s)				=  Id (incr a E s)
->
-> incr					:: a -> t a -> FST1 t a -> FST1 t a
-> incr a1 t1 (S2 a2)			=  S3 a1 t1 a2
-> incr a1 t1 (S3 a2 t2 a3)		=  C (One (Cons a1 t1)) (S2 a2) (One (Snoc t2 a3))
-> incr a1 t1 (C (One (Cons a2 t2)) m r)	=  C (Two (Cons a1 (N2 t1 a2 t2))) m r
-> incr a1 t1 (C (Two (Cons a2 (N2 t2 a3 t3))) m r)
->     =  {-"\enskip\,"-} C (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) m r
-> incr a1 t1 (C (Two (Cons a2 (N3 t2 a3 t3 a4 t4))) m r)
->     =  {-"\enskip\,"-} C (Two (Cons a1 (N2 t1 a2 t2))) (incr a3 (N2 t3 a4 t4) m) r
-
-It is instructive to relate the equations to the rebalancing operations
-on 2-3 trees.  The first equation corresponds to an expansion of a
-2-node to a 3-node, the second equation realizes a split of a 3-node
-into two 2-nodes.
-%if codeOnly
-
-> s4					:: a -> t a -> a -> t a -> a -> FST1 t a
-> s4 a1 t1 a2 t2 a3			=  C (One (Cons a1 t1)) (S2 a2) (One (Snoc t2 a3))
->
-> snoc					:: OrdSequence a -> a -> OrdSequence a
-> snoc Nil a				=  Id (S2 a)
-> snoc (Id s) a				=  Id (rcni s E a)
->
-> rcni					:: FST1 t a -> t a -> a -> FST1 t a
-> rcni (S2 a1) t1 a2	 		=  S3 a1 t1 a2
-> rcni (S3 a1 t1 a2) t2 a3		=  s4 a1 t1 a2 t2 a3
-> rcni (C f m (One (Snoc t1 a1))) t2 a2	=  C f m (Two (Snoc (N2 t1 a1 t2) a2))
-> rcni (C f m (Two (Snoc (N2 t1 a1 t2) a2))) t3 a3
->     =  {-"\enskip\,"-} C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))
-> rcni (C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))) t4 a4
->     =  {-"\enskip\,"-} C f (rcni m (N2 t1 a1 t2) a2) (Two (Snoc (N2 t3 a3 t4) a4))
-
-> zero'					:: FST1 (Node23 t) a -> Digit Rear t a -> FST1 t a
-> zero' (S2 a1) (One (Snoc t1 a2))	=  S3 a1 t1 a2
-> zero' (S2 a1) (Two (Snoc (N2 t1 a2 t2) a3))
->					=  s4 a1 t1 a2 t2 a3
-> zero' (S2 a1) (Two (Snoc (N3 t1 a2 t2 a3 t3) a4))
->					=  C (One (Cons a1 t1)) (S2 a2) (Two (Snoc (N2 t2 a3 t3) a4))
-> zero' (S3 a1 t1 a2) d			=  C (Two (Cons a1 t1)) (S2 a2) d
-> zero' (C (One p) m r) d		=  C (Two p) (zero' m r) d
-> zero' (C (Two (Cons a1 (N2 t1 a2 t2))) m r) d
->					=  C (Two (Cons a1 t1)) (C (One (Cons a2 t2)) m r) d
-> zero' (C (Two (Cons a1 (N3 t1  a2 t2 a3 t3))) m r) d
->					=  C (Two (Cons a1 t1)) (C (Two (Cons a2 (N2 t2 a3 t3))) m r) d
->
-> splitMin				:: OrdSequence a -> OptPair a (OrdSequence a)
-> splitMin Nil				=  NoPair
-> splitMin (Id (S2 a1))			=  Pair a1 Nil
-> splitMin (Id (S3 a1 E a2))		=  Pair a1 (Id (S2 a2))
-> splitMin (Id (C (One (Cons a1   E)) m r))
->					=  Pair a1 (Id (zero' m r))
-> splitMin (Id (C (Two (Cons a1  (N2 E a2 E))) m r))
->					=  Pair a1 (Id (C (One (Cons a2 E)) m r))
-> splitMin (Id (C (Two (Cons a1  (N3 E a2 E a3 E))) m r))
->					=  Pair a1 (Id (C (Two (Cons a2 (N2 E a3 E))) m r))
-
-> eroz					:: Digit Front t a -> FST1 (Node23 t) a -> FST1 t a
-> eroz (One (Cons a1 t1)) (S2 a2)	=  S3 a1 t1 a2
-> eroz (Two (Cons a1 (N2 t1 a2 t2))) (S2 a3)
->					=  s4 a1 t1 a2 t2 a3
-> eroz (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) (S2 a4)
->					=  C (Two (Cons a1 (N2 t1 a2 t2))) (S2 a3) (One (Snoc t3 a4))
-> eroz d (S3 a1 t1 a2)			=  C d (S2 a1) (Two (Snoc t1 a2))
-> eroz d (C f m (One p))		=  C d (eroz f m) (Two p) 
-> eroz d (C f m (Two (Snoc (N2 t1 a1 t2) a2)))
->					=  C d (C f m (One (Snoc t1 a1))) (Two (Snoc t2 a2)) 
-> eroz d (C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3)))
->					=  C d (C f m (Two (Snoc (N2 t1 a1 t2) a2))) (Two (Snoc t3 a3)) 
-
-%endif
-%}
-%align 33
-
-\smallskip
-\noindent\textbf{Remark.} \Todo{Pattern abstractions}
-
-< D1 a1 t1			=  One (Cons a1 t1)
-< D2 a1 t1 a2 t2		=  Two (Cons a1 (N2 t1 a2 t2))
-< D3 a1 t1 a2 t2 a3 t3		=  Two (Cons a1 (N3 t1 a2 t2 a3 t3))
-
-blub\hfill$\Box$
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Bag operations}
-\label{sec:bag}
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-
-\Todo{Worte zu |insert| und |delete|}. To adapt |member| we must first
-symmetrize the auxiliary datatype |Loc|.
-%format fun			=  "(\star)"
-%format `fun`			=  "\star "
-
-> data Loc a			=  Lt | Eq a | Gt
-> 
-> between			:: a -> Loc a -> a -> a
-> between a1 Lt a3		=  a1
-> between a1 (Eq a2) a3		=  a2
-> between a1 Gt a3		=  a3
-
-%format fun (f) (a)		=  f "\star " a
-The function |between| generalizes the operator |after| of
-Section~\ref{sec:search}. Depending on the value of the second
-argument the search is continued to the left or to the right.
-
-%format min'			=  min
-%format max'			=  max
-%subst code a    	= "\begin{array}{@{}lcl}'n" a "'n\end{array}"
-\[
-\begin{array}{c@@{\qquad}c}
-
-> min' (One (Cons m t))		=  m
-> min' (Two (Cons m t))		=  m
->
-> max' (One (Snoc t m))		=  m
-> max' (Two (Snoc t m))		=  m
-
-&
-
-> memf a (One (Cons m t))	=  mem a t
-> memf a (Two (Cons m t))	=  mem a t
->
-> memr a (One (Snoc t m))	=  mem a t
-> memr a (Two (Snoc t m))	=  mem a t
-
-\end{array}
-\]
-%subst code a    	= "\[\begin{array}{@{}lcl}'n\hspace{\lwidth}&\hspace{\cwidth}&\\[-10pt]'n" a "'n\end{array}\]"
-The function |member'| implements a quasi-parallel search along the two
-spines.  If $d_1$ is the distance from the smallest element and $d_2$
-the distance from the largest element, then |member| runs in
-$\Theta(\min\{d_1, d_2\})$.
-
-> member'			:: (Ord a, Mem t) => a -> FST1 t a -> Loc Bool
-> member' a (S2 a1)
->     | a < a1			=  Lt
->     | a > a1			=  Gt
->     | otherwise		=  Eq True
-> member' a (S3 a1 t1 a2)
->     | a < a1			=  Lt
->     | a > a2			=  Gt
->     | otherwise		=  Eq (mem a t1)
-> member' a (C f m r)
->     | a < min' f		=  Lt
->     | a > max' r		=  Gt
->     | otherwise		=  Eq (between (memf a f) (member' a m) (memr a r))
->
-> member			:: (Ord a) => a -> OrdSequence a -> Bool
-> member a Nil			=  False
-> member a (Id s)		=  between False (member' a s) False
-
-
-The adaptive sorting algorithm described in Section~\ref{sec:insert}
-has the irritating property that the worst case is a list in descending
-order which is arguably almost sorted. In a sense this is due to the
-measure |Inv| which yields the largest value for lists in descreasing
-order. If we represent ordered sequences with 2-3 trees under the
-symmetric spine view we obtain a sorting algorithm which is optimal
-with respect to $\widehat{|Inv|}$ given by
-\[
-    \widehat{|Inv|}(x) = \min\{|Inv|(x), |Inv|(|reverse x|)\} \enskip.
-\]
-The new worst-case is an interleaving of an ascending and a descending
-list:
-\[
-    1, 2n, 2, 2n-1, 3, 2n-2, \ldots, n-2, n+1, n-1, n \enskip.
-\]
-
-%if codeOnly
-
-> fun				:: (a -> b) -> Loc a -> Loc b
-> f `fun` Lt			=  Lt
-> f `fun` (Eq a)		=  Eq (f a)
-> f `fun` Gt			=  Gt
-
-> class Mem tree where
->     mem			:: (Ord a) => a -> tree a -> Bool
->
-> instance Mem Empty where
->     mem a E			=  False
->
-> instance (Mem tree) => Mem (Node23 tree) where
->     mem a (N2 t1 a1 t2)
->         | a < a1		=  mem a t1
->         | a == a1		=  True
->         | otherwise		=  mem a t2
->     mem a (N3 t1 a1 t2 a2 t3)
->         | a < a1		=  mem a t1
->         | a == a1		=  True
->         | a < a2		=  mem a t2
->         | a == a2		=  True
->         | otherwise		=  mem a t3
-
-> type Sequ a			=  [a] -> [a]
->
-> empty				=  \x -> x
->
-> unit a			=  \x -> a : x
-
-> class Inorder tree where
->     inorder			:: tree a -> Sequ a
->
-> instance Inorder Empty where
->     inorder E			=  empty
->
-> instance (Inorder tree) => Inorder (Node23 tree) where
->     inorder (N2 t1 a1 t2)	=  inorder t1 . unit a1 . inorder t2
->     inorder(N3 t1 a1 t2 a2 t3)=  inorder t1 . unit a1 . inorder t2 . unit a2 . inorder t3
->
-> inord (One p)			=  inorder p
-> inord (Two p)			=  inorder p
->
-> instance (Inorder tree) => Inorder (Front tree) where
->     inorder (Cons a t)	=  unit a . inorder t
->
-> instance (Inorder tree) => Inorder (Rear tree) where
->     inorder (Snoc t a)	=  inorder t . unit a
-
-> toList'			:: (Inorder tree) => FingerSearchTree1 tree a -> Sequ a
-> toList' (S2 a1)		=  unit a1
-> toList' (S3 a1 t1 a2)		=  unit a1 . inorder t1 . unit a2
-> toList' (C f m r)		=  inord f . toList' m . inord r
-
-> toList			:: OrdSequence a -> [a]
-> toList Nil			=  []
-> toList (Id s)			=  toList' s []
-
-%endif
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Concatenation}
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-
-%include Pic8.lhs
-
-> (<>)				:: OrdSequence a -> OrdSequence a -> OrdSequence a
-> Nil <> s2			=  s2
-> s1 <> Nil			=  s1
-> Id s1 <> Id s2		=  Id (app s1 (U E) s2)
-
-$a3 = (a+1)1$
-
-%align 49
-
-> norm (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) m	=  (One (Cons a1 t1), incr a2 (N2 t2 a3 t3) m)
-> norm f m					=  (f, m)
-
-%align 41
-
-> app					:: FST1 t a -> Grown t a -> FST1 t a -> FST1 t a
-> app (S2 a1) (U t1) x			=  incr a1 t1 x
-> app (S2 a1) (G t1 a2 t2) x		=  incr a1 t1 (incr a2 t2 x)
-> app x (U t1) (S2 a1)			=  rcni x t1 a1
-> app x (G t1 a1 t2) (S2 a2)		=  rcni (rcni x t1 a1) t2 a2
-> app (S3 a1 t1 a2) (U t2) x		=  incr a1 t1 (incr a2 t2 x)
-> app (S3 a1 t1 a2) (G t2 a3 t3) x	=  incr a1 t1 (incr a2 t2 (incr a3 t3 x))
-> app x (U t1) (S3 a1 t2 a2)		=  rcni (rcni x t1 a1) t2 a2
-> app x (G t1 a1 t2) (S3 a2 t3 a3)	=  rcni (rcni (rcni x t1 a1) t2 a2) t3 a3
-> app (C f1 m1 r1) t (C f2 m2 r2)	=  C f1 (app m1' (join r1' t f2') m2') r2
->     where (m1', r1')			=  mron m1 r1
->           (f2', m2')			=  norm f2 m2
-
-%align 33
-
-< join				:: Digit Rear t a -> Grown t a -> Digit Front t a -> Grown (Node23 t) a
-< join (One (Snoc t1 a1))  (U t2) (One (Cons a2 t3))
-<				=  U (N3 t1 a1 t2 a2 t3)
-< join (One (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
-<				=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
-< {-"\ldots"-}
-< join (Two (Snoc (N2 t1 a1 t2) a2)) (G t3 a3 t4) (Two (Cons a4 (N2 t5 a5 t6)))
-<				=  G (N3 t1 a1 t2 a2 t3) a3 (N3 t4 a4 t5 a5 t6)
-
-%if codeOnly
-
-
-> mron m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))	=  (rcni m (N2 t1 a1 t2) a2, One (Snoc t3 a3))
-> mron m r					=  (m, r)
->
-> join				:: Digit Rear t a -> Grown t a -> Digit Front t a -> Grown (Node23 t) a
-> join (One (Snoc t1 a1))  (U t2) (One (Cons a2 t3))
->				=  U (N3 t1 a1 t2 a2 t3)
-> join (One (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
->				=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
-> join (One (Snoc t1 a1))  (U t2) (Two (Cons a2 t3))
->				=  G (N2 t1 a1 t2) a2 t3
-> join (One (Snoc t1 a1)) (G t2 a2 t3) (Two (Cons a3 t4))
->				=  G (N3 t1 a1 t2 a2 t3) a3 t4
-> join (Two (Snoc t1 a1)) (U  t2) (One (Cons a2 t3))
->				=  G t1 a1 (N2 t2 a2 t3)
-> join (Two (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
->				=  G t1 a1 (N3 t2 a2 t3 a3 t4)
-> join (Two (Snoc (N2 t1 a1 t2) a2)) (U t3) (Two (Cons a3 t4))
->				=  G (N3 t1 a1 t2 a2 t3) a3 t4
-> join (Two (Snoc (N2 t1 a1 t2) a2)) (G t3 a3 t4) (Two (Cons a4 (N2 t5 a5 t6)))
->				=  G (N3 t1 a1 t2 a2 t3) a3 (N3 t4 a4 t5 a5 t6)
-
-%endif
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Splitting}
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-
-> part				:: (Ord a) => a -> FST1 t a -> Loc (FST1 t a, t a, FST1 t a)
-> part a (S2 a1)
->     | a <= a1			=  Lt
->     | otherwise		=  Gt
-> part a (S3 a1 t1 a2)
->     | a <= a1			=  Lt
->     | a >= a2			=  Gt
->     | otherwise		=  Eq (S2 a1, t1, S2 a2)
-> part a (C f m r)
->     | a <= min' f		=  Lt
->     | a >= max' r		=  Gt
->     | otherwise		=  Eq (between (cutf f) (cutm `fun` part a m) (cutr r))
->     where
->     cutm (m1, t, m2)		=  split a f m1 t m2 r
->     cutf (One (Cons a1 t1))	=  (S2 a1, t1, zero' m r)
->     cutf (Two (Cons a1 t1))	=  lsplit a a1 t1 m r
->     cutr (One (Snoc t1 a1))	=  (eroz f m, t1, S2 a1)
->     cutr (Two (Snoc t1 a1))	=  rsplit a f m t1 a1
-
-> split a f m1 (N2 t1 a1 t2) m2 r
->     | a <= a1			=  (eroz f m1, t1, C (One (Cons a1 t2)) m2 r)
->     | otherwise		=  (C f m1 (One (Snoc t1 a1)), t2, zero' m2 r)
-> split a f m1 (N3 t1 a1 t2 a2 t3) m2 r
->     | a <= a1			=  (eroz f m1, t1, C (Two (Cons a1 (N2 t2 a2 t3))) m2 r)
->     | a <= a2			=  (C f m1 (One (Snoc t1 a1)), t2, C (One (Cons a2 t3)) m2 r)
->     | otherwise		=  (C f m1 (Two (Snoc (N2 t1 a1 t2) a2)), t3, zero' m2 r)
-
-%if codeOnly
-
-> lsplit a a1 (N2 t1 a2 t2) m2 r
->     | a <= a2			=  (S2 a1, t1, C (One (Cons a2 t2)) m2 r)
->     | otherwise		=  (zero' (S2 a1) (One (Snoc t1 a2)), t2, zero' m2 r)
-> lsplit a a1 (N3 t1 a2 t2 a3 t3) m2 r
->     | a <= a2			=  (S2 a1, t1, C (Two (Cons a2 (N2 t2 a3 t3))) m2 r)
->     | a <= a3			=  (zero' (S2 a1) (One (Snoc t1 a2)), t2, C (One (Cons a3 t3)) m2 r)
->     | otherwise		=  (zero' (S2 a1) (Two (Snoc (N2 t1 a2 t2) a3)), t3, zero' m2 r)
-
-> rsplit a f m1 (N2 t1 a1 t2) a2
->     | a <= a1			=  (eroz f m1, t1, eroz (One (Cons a1 t2)) (S2 a2))
->     | otherwise		=  (C f m1 (One (Snoc t1 a1)), t2, S2 a2)
-> rsplit a f m1 (N3 t1 a1 t2 a2 t3) a3
->     | a <= a1			=  (eroz f m1, t1, eroz (Two (Cons a1 (N2 t2 a2 t3))) (S2 a3))
->     | a <= a2			=  (C f m1 (One (Snoc t1 a1)), t2, eroz (One (Cons a2 t3)) (S2 a3))
->     | otherwise		=  (C f m1 (Two (Snoc (N2 t1 a1 t2) a2)), t3, S2 a3)
-
-%endif
-
-> partition			:: (Ord a) => a -> OS a -> (OS a, OS a)
-> partition a Nil		=  (Nil, Nil)
-> partition a (Id t)		=  between (Nil, Id t) (wrap `fun` part a t) (Id t, Nil)
->   where wrap (t1, E, t2)	=  (Id t1, Id t2)
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-\subsection{Margesort}
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-
-Nicht stabil!
-
-> merge				:: (Ord a) => OS a -> OS a -> OS a
-> merge x y			=  case splitMin y of
->     NoPair			-> x
->     Pair a y'			-> x1 <> cons a (merge y' x2)
->         where (x1, x2)	=  partition a x
-
-> margeSort			:: (Ord a) => [a] -> [a]
-> margeSort			=  toList . foldm merge Nil . map single
->
-> single			:: a -> OrdSequence a
-> single a			=  Id (S2 a)
-
-> naturalMargeSort		:: (Ord a) => [a] -> [a]
-> naturalMargeSort		=  toList . foldm merge Nil . map fromList . upDownRunsBy (<=)
-
-Wenn es viele gleiche Elemente gibt ... NAJA lineare Suche statt bin"arer
-
-> merge2			:: (Ord a) => OS a -> OS a -> OS a
-> merge2 x y			=  case splitMin y of
->     NoPair			-> x
->     Pair a y'			-> (x1 <> x3) <> cons a (merge2 y' x4)
->         where (x1, x2)	=  partition a x
->               (x3, x4)	=  splitWhile (== a) x2
-
-> splitWhile p s		=  case splitMin s of
->     NoPair			-> (Nil, Nil)
->     Pair a s'
->         | p a			-> (cons a s1, s2)
->         | otherwise		-> (Nil, s)
->         where (s1, s2)	=  splitWhile p s'
-
-% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
-%if codeOnly
-
-and [ x == toList (fromList x) | n <- [0 .. 500], let x = [1 .. n] ]
-
-and [ x ++ y == toList (fromList x <> fromList y) | m <- [0 .. 100], n <- [0 .. 100], let x = [1 .. m], let y = [1 .. n] ]
-
-[ (m, n) | m <- [0 .. 100], n <- [0 .. 100], let x = [1 .. m], let y = [m `div` 2 .. n + m `div` 2], meld x y /= toList (fromList x `merge` fromList y) ]
-
-ordered (margeSort $ take 1500 $ random2Ints 2432 234)
-
-and [ ordered (margeSort $ take n $ random2Ints 2432 234) | n <- [0 .. 1500] ]
-
-> fromList []			=  Nil
-> fromList as			=  Id (fromList1 as)
->
-> fromList1 [a]			=  S2 a
-> fromList1 (a : as)		=  incr a E (fromList1 as)
-
-> foldm				:: (a -> a -> a) -> a -> [a] -> a
-> foldm (*) e []		=  e
-> foldm (*) e x			=  fst (rec (length x) x)
->     where rec 1 (a:x)		=  (a, x)
->           rec n x		=  (a * b, z)
->               where m		=  n `div` 2
->                     (a, y)	=  rec (n - m) x 
->                     (b, z)	=  rec m       y
-
-> random2Ints           	:: Int -> Int -> [Int]
-> random2Ints s1 s2
->   | s1 < 1 || s1 > 2147483562	=  error "random2Ints: Bad first seed."
->   | s2 < 1 || s2 > 2147483398	=  error "random2Ints: Bad second seed."
->   | otherwise			=  rands s1 s2
-
-> rands                		:: Int -> Int -> [Int]
-> rands s1 s2
->     | z < 1			=  z + 2147483562 : rands s1'' s2''
->     | otherwise		=  z              : rands s1'' s2''
->     where k			=  s1 `div` 53668
->           s1'			=  40014 * (s1 - k * 53668) - k * 12211
->           s1'' | s1' < 0	=  s1' + 2147483563
->                | otherwise	=  s1'
->           k'			=  s2 `div` 52774
->           s2'			=  40692 * (s2 - k' * 52774) - k' * 3791
->           s2'' | s2' < 0	=  s2' + 2147483399
->                | otherwise    =  s2'
->           z			=  s1'' - s2''
-
-> ordered			:: (Ord a) => [a] -> Bool
-> ordered []			=  True
-> ordered [a]			=  True
-> ordered (a1 : as @ (a2 : _))	=  a1 <= a2 && ordered as
-
-> meld [] y			=  y
-> meld x@(a:_) []		=  x
-> meld x@(a:x') y@(b:y')
->     | a <= b			=  a : meld x' y
->     | otherwise		=  b : meld x  y'
-
-Konversion in `richtige' 2-3-4 B"aume f"ur die graphische Darstellung.
-
-> data Tree24 a			=  Void
->				|  Node2 (Tree24 a) a (Tree24 a)
->				|  Node3 (Tree24 a) a (Tree24 a) a (Tree24 a)
->				|  Node4 (Tree24 a) a (Tree24 a) a (Tree24 a) a (Tree24 a)
-
-> class Conv tree where
->     conv			:: tree a -> Tree24 a
->
-> instance Conv Empty where
->     conv E			=  Void
->
-> instance (Conv tree) => Conv (Node23 tree) where
->     conv (N2 t1 a1 t2)	=  Node2 (conv t1) a1 (conv t2)
->     conv (N3 t1 a1 t2 a2 t3)	=  Node3 (conv t1) a1 (conv t2) a2 (conv t3)
-
-> convert Nil			=  Void
-> convert (Id s)		=  convert' Void s Void
-
-> convert'			:: (Conv t) => Tree24 a -> FST1 t a -> Tree24 a -> Tree24 a
-> convert' l (S2 a1) r		=  Node2 l a1 r
-> convert' l (S3 a1 t1 a2) r	=  Node3 l a1 (conv t1) a2 r
-> convert' l (C f m r) r'	=  convert' (link l f) m (knil r r')
-
-> link t1 (One (Cons a1 t2))			=  Node2 t1 a1 (conv t2)
-> link t1 (Two (Cons a1 (N2 t2 a2 t3)))		=  Node3 t1 a1 (conv t2) a2 (conv t3)
-> link t1 (Two (Cons a1 (N3 t2 a2 t3 a3 t4)))	=  Node4 t1 a1 (conv t2) a2 (conv t3) a3 (conv t4)
->
-> knil (One (Snoc t1 a1)) t2			=  Node2 (conv t1) a1 t2
-> knil (Two (Snoc (N2 t1 a1 t2) a2)) t3		=  Node3 (conv t1) a1 (conv t2) a2 t3
-> knil (Two (Snoc (N3 t1 a1 t2 a2 t3) a3)) t4	=  Node4 (conv t1) a1 (conv t2) a2 (conv t3) a3 t4
-
-convert $ fromList [1 .. 12]
-
-convert $ fromList [1 .. 17]
-convert $ fromList [18 .. 24]
-convert $ fromList [1 .. 17] <> fromList [18 .. 24]
-
-convert $ fst $ partition 13 (fromList [1 .. 17] <> fromList [18 .. 24])
-convert $ snd $ partition 13 (fromList [1 .. 17] <> fromList [18 .. 24])
-
-%endif
− Swish/HaskellRDF/Sort/MergeSort.lhs 
@@ -1,295 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Sorting by merging}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.MergeSort 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.ListLib
-
-> infixr {-"\,"-} `merge`, \+/
-
-%align 33
-
-> sort				:: (Ord a) => [a] -> [a]
-> sort				=  bottomUpMergeSort
-
-%-------------------------------=  --------------------------------------------
-\section{Top-down merge sort}
-%-------------------------------=  --------------------------------------------
-
-The archetypical functional sorting algorithm is without any doubt
-merge sort. It follows the divide and conquer scheme: the input list is
-split into two halves, both are sorted recursively and the results are
-finally merged together.
-
-> merge				:: (Ord a) => [a] -> [a] -> [a]
-> merge				=  mergeBy (<=)
->
-> (\+/)				:: (Ord a) => [a] -> [a] -> [a]
-> (\+/)				=  mergeBy (<=)
->
-> mergeBy			:: Rel a -> [a] -> [a] -> [a]
-> mergeBy (<=)			=  merge
->     where
->     merge [] bs		=  bs
->     merge as@(_ : _) []	=  as
->     merge as@(a : as') bs@(b : bs')
->         | a <= b		=  a : merge as' bs
->	  | otherwise		=  b : merge as  bs'
->
-> mergeSort			:: (Ord a) => [a] -> [a]
-> mergeSort			=  mergeSortBy (<=)
->
-> mergeSortBy			:: Rel a -> [a] -> [a]
-> mergeSortBy (<=) as
->     | simple as		=  as
->     | otherwise		=  mergeBy (<=) (mergeSortBy (<=) as1)
->				                (mergeSortBy (<=) as2)
->     where (as1, as2)		=  halve as
-
-Since the divide phase takes $\Theta(n\log n)$ time, |mergeSort| is
-not lazy: |head . mergeSort| has a running time of $\Theta(n\log n)$.
-
-%-------------------------------=  --------------------------------------------
-\section{Bottom-up merge sort}
-%-------------------------------=  --------------------------------------------
-
-The function |bottomUpMergeSort| improves the divide phase to
-$\Theta(n)$ and is consequently asymptotically optimal, stable, and
-lazy, but alas not in any way adaptive.
-
-> bottomUpMergeSort		:: (Ord a) => [a] -> [a]
-> bottomUpMergeSort		=  bottomUpMergeSortBy (<=)
->
-> bottomUpMergeSortBy		:: Rel a -> [a] -> [a]
-> bottomUpMergeSortBy (<=)	=  gfoldm [] (\a -> [a]) (mergeBy (<=))
-
-%-------------------------------=  --------------------------------------------
-\section{Straight merge sort}
-%-------------------------------=  --------------------------------------------
-
-Both |mergeSort| and |bottomUpMergeSort| take $\Theta(n\log n)$
-irrespective of the presortedness of the input. If we replace the test
-|simple| by |ordered| we obtain an adaptive variant which is optimal
-with respect to the measure |Runs| and adaptive wrt |Inv| and |Rem|
-\cite[p.~449]{ECW92Sur}.
-
-> straightMergeSort		:: (Ord a) => [a] -> [a]
-> straightMergeSort		=  straightMergeSortBy (<=)
-
-> straightMergeSortBy		:: Rel a -> [a] -> [a]
-> straightMergeSortBy (<=) as
->     | orderedBy (<=) as	=  as
->     | otherwise		=  mergeBy (<=) (straightMergeSortBy (<=) as1)
->				                (straightMergeSortBy (<=) as2)
->     where (as1, as2)		=  halve as
-
-\Todo{To adapt to ascending as well as descending sequences we could
-reverse the sublists in every step and apply Augustson's
-stable/anti-stable trick.}
-
-%-------------------------------=  --------------------------------------------
-\section{Odd-even merge sort}
-%-------------------------------=  --------------------------------------------
-
-If we use a different partioning scheme, |uninterleave| instead of
-|halve|, we obtain an adaptive variant which is optimal wrt |Dis = Max|
-\cite[p.~450]{ECW92Sur}.
-
-> oddEvenMergeSort		:: (Ord a) => [a] -> [a]
-> oddEvenMergeSort		=  oddEvenMergeSortBy (<=)
->
-> oddEvenMergeSortBy		:: Rel a -> [a] -> [a]
-> oddEvenMergeSortBy (<=) as
->     | orderedBy (<=) as	=  as
->     | otherwise		=  mergeBy (<=) (oddEvenMergeSortBy (<=) as1)
->						(oddEvenMergeSortBy (<=) as2)
->     where (as1, as2)		=  uninterleave as
-
-Unfortunately, |oddEvenMergeSort| is no longer stable. Consider, for
-instance, |uninterleave [a1, a2, a3] = ([a1, a3], [a2])| and assume
-that the three elements are equal. However, |oddEvenMergeSort| can be
-improved so that the divide phase takes only linear time. This is left
-as an instructive exercise to the reader.
-
-%-------------------------------=  --------------------------------------------
-\section{Split sort}
-%-------------------------------=  --------------------------------------------
-
-A partioning scheme which adapts to |Rem| was given by Levcopoulos
-and Petersson \cite[p.~451]{ECW92Sur} and is based on a method by
-Cook and Kim for removing $\Theta(|Rem(as)|)$ elements from a list
-|as|, such that an ordered sequence is left over.
-
-The function |lpDivision as| divides its input into three lists |g|,
-|s|, and |l| such that |s| is sorted and |g| and |l| have the same
-length which is at most |Rem(as)|. The tricky thing is to ensure that
-the splitting is performed in a stable way, ie the order in which the
-elements in |g| and |l| appear is the same in which they appear in
-|as|. Consider the sequence |1 2 5 1 4 3 1 9 2 8 9 1|:
-%
-\[
-\begin{array}{l||l||r}
-\text{|g| and |s|} & |l| & |as| \\\hline
-|1 2 5| & & |1 4 3 1 9 2 8 9 1| \\
-|1 2 [5]| & |1| & |4 3 1 9 2 8 9 1| \\
-|1 2 [5] 4| & |1| & |3 1 9 2 8 9 1| \\
-|1 2 [5 4]| & |3 1| & |1 9 2 8 9 1| \\
-|1 [2 5 4]| & |1 3 1| & |9 2 8 9 1| \\
-|1 [2 5 4] 9| & |1 3 1| & |2 8 9 1| \\
-|1 [2 5 4 9]| & |2 1 3 1| & |8 9 1| \\
-|1 [2 5 4 9] 8| & |2 1 3 1| & |9 1| \\
-|1 [2 5 4 9] 8 9| & |2 1 3 1| & |1| \\
-|1 [2 5 4 9] 8 [9]| & |1 2 1 3 1| &
-\end{array}
-\]
-The data type |Region| is designed to represent |g| and |s|. Elements
-in |g| are grouped to allow for efficient access to the last element in
-|s|. For instance, |1 [2 5 4 9] 8 [9]| is essentially represented by |G
-(S (G (S Nil 1) [2, 5, 4, 9]) 8) [9]|.
-
-> type Sequ a			=  [a] -> [a]
->
-> data Region a			=  Nil
->				|  S (Region a) a
->				|  G (Region a) (Sequ a)
->
-> single			:: a -> Sequ a
-> single a			=  \x -> a : x
->
-> g				:: Region a -> Sequ a -> Region a
-> g Nil gs			=  G Nil gs
-> g (S s a) gs			=  G (S s a) gs
-> g (G s gs1) gs2		=  G s (gs1 . gs2)
->
-> lpDivisionBy			:: Rel a -> [a] -> ([a], [a], [a])
-> lpDivisionBy (<=) []          =  ([], [], [])
-> lpDivisionBy (<=) (a : as)    =  lp (S Nil a) [] as
->     where
->     lp s l []              	=  (g [], reverse s', reverse l)
->         where (g, s')		=  lpPart s
->     lp Nil l (a : as)		=  lp (S Nil a) l as
->     lp s@(G Nil gs) l (a : as)=  lp (S s a) l as
->     lp s@(G (S s' m) gs) l (a : as)
->         | m <= a		=  lp (S s a) l as
->         | otherwise		=  lp (g s' (single m . gs)) (a : l) as
->     lp (G (G _ _) _) _ (_ : _)=  error "lp"
->     lp s@(S s' m) l (a : as)
->         | m <= a		=  lp (S s a) l as
->         | otherwise		=  lp (g s' (single m)) (a : l) as
->
-> lpPart			:: Region a -> ([a] -> [a], [a])
-> lpPart Nil			=  (id, [])
-> lpPart (S s a)		=  (g, a : s')
->     where (g, s')		=  lpPart s
-> lpPart (G s gs)		=  (gs . g, s')
->     where (g, s')		=  lpPart s
-
-Unfortunately, the relative order between equal elements in |g ++ s ++ l|
-is not the same as in |as|. Hence, |lpMergeSort| is not stable either.
-
-> lpMergeSort			:: (Ord a) => [a] -> [a]
-> lpMergeSort			=  lpMergeSortBy (<=)
->
-> lpMergeSortBy			:: Rel a -> [a] -> [a]
-> lpMergeSortBy (<=) as
->     | simple as		=  as
->     | otherwise		=  mergeBy (<=) (lpMergeSortBy (<=) as1)
->				       (mergeBy (<=) s (lpMergeSortBy (<=) as2))
->     where (as1, s, as2)	=  lpDivisionBy (<=) as
-
-\Todo{To adapt to ascending as well as descending sequences we could
-reverse the sublists in every step. \NB stability is already lost.}
-
-%-------------------------------=  --------------------------------------------
-\section{Adaptive merge sort}
-%-------------------------------=  --------------------------------------------
-%format sort1			=  sort "_1"
-%format sort2			=  sort "_2"
-%format sort3			=  sort "_3"
-
-If we combine |halve|, |uninterleave|, and |lpDivision| we obtain
-a sorting algorithm which is adaptive wrt |Exc|, |Dis|, |Inv|, |Rem|,
-and |Runs| \cite[p.~451]{ECW92Sur}.
-
-> adaptiveMergeSort		:: (Ord a) => [a] -> [a]
-> adaptiveMergeSort		=  adaptiveMergeSortBy (<=)
->
-> adaptiveMergeSortBy		:: Rel a -> [a] -> [a]
-> adaptiveMergeSortBy (<=)	=  sort1
->     where
->     (\+/)			=  mergeBy (<=)
->
->     sort1 as
->         | simple as		=  as
->         | otherwise		=  sort2 as1 \+/ s \+/ sort2 as2
->         where (as1, s, as2)	=  lpDivisionBy (<=) as
->
->     sort2 as			=  sort3 as1 \+/ sort3 as2
->         where (as1, as2)	=  uninterleave as
->
->     sort3 as			=  sort1 as1 \+/ sort1 as2
->         where (as1, as2)	=  halve as
-
-\Todo{How about reversing the lists in the first step in order to adapt
-to descending sequences as well? cf.~\cite[p.~52]{ECW91Pra}}
-
-%-------------------------------=  --------------------------------------------
-\section{Natural merge sort}
-%-------------------------------=  --------------------------------------------
-
-The function |straightMergeSort| somehow guesses the number of runs. It is
-more efficient to group the input into runs beforehand.
-
-> naturalMergeSort		:: (Ord a) => [a] -> [a]
-> naturalMergeSort		=  naturalMergeSortBy (<=)
->
-> naturalMergeSortBy		:: Rel a -> [a] -> [a]
-> naturalMergeSortBy (<=)	=  foldm (mergeBy (<=)) [] . runsBy (<=)
->
-> runsBy			:: Rel a -> [a] -> [[a]]
-> runsBy (<=) []		=  [[]]
-> runsBy (<=) (a : as)		=  upRun a [] as
->     where
->     upRun m r []		=  [reverse (m : r)]
->     upRun m r (a : as)
->         | m <= a		=  upRun a (m : r) as
->         | otherwise		=  reverse (m : r) : upRun a [] as
-
-Natural merge sort was first studied in the context of external
-sorting.  The hbc library contains a similar function.
-
-The function |runs| recognized only ascending runs. With little
-additional effort we can also detect descending runs.
-
-> symmetricNaturalMergeSort	:: (Ord a) => [a] -> [a]
-> symmetricNaturalMergeSort	=  symmetricNaturalMergeSortBy (<=)
->
-> symmetricNaturalMergeSortBy	:: Rel a -> [a] -> [a]
-> symmetricNaturalMergeSortBy (<=)
->				=  foldm (mergeBy (<=)) [] . upDownRunsBy (<=)
->
-> upDownRunsBy			:: Rel a -> [a] -> [[a]]
-> upDownRunsBy (<=) []		=  []
-> upDownRunsBy (<=) (a : as)	=  upDownRun a as
->     where
->     upDownRun a []		=  [[a]]
->     upDownRun a1 (a2 : as)
->         | a1 <= a2		=  upRun   a2 [a1] as
->         | otherwise		=  downRun a2 [a1] as
->     upRun m r []		=  [reverse (m : r)]
->     upRun m r (a : as)
->         | m <= a		=  upRun a (m : r) as
->         | otherwise		=  reverse (m : r) : upDownRun a as
->
->     downRun m r []		=  [m : r]
->     downRun m r (a : as)
->         | m <= a		=  (m : r) : upDownRun a as
->         | otherwise		=  downRun a (m : r) as
-
-\NB To preserve stability |downRun| uses only \emph{strictly}
-decreasing sequences: |[n, n, n-1, n-1, .. 1, 1]| is split into |n|
-runs. Does anybody know of a better solution?
− Swish/HaskellRDF/Sort/PairingHeap.lhs 
@@ -1,88 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Pairing heaps}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.PairingHeap 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.ListLib (treefold)
-> infixr {-"\,"-} \+/
-
-%align 33
-
-Sorting based on pairing heaps \cite[p.~52]{Oka98Pur} performs
-extremely well in practice and it combines many virtues: it is
-asymptotically optimal (at least |pairingSort|, for |mpPairingSort|
-which is based on multi-pass pairing heaps no tight theoretical bounds
-are known), it is lazy and I conjecture that it adapts to the input.
-However, to the best of my knowledge this has not been shown. On the
-negative side, it is not stable which is typical for sorting algorithms
-based on priority queues.
-
-> data PairingHeap a            =  Empty
->                               |  Node a [PairingHeap a]
-
-\NB The constructor |Empty| is only used on the top-level, it never
-appears below a |Node|.
-
-> leaf				:: a -> PairingHeap a
-> leaf a                  	=  Node a []
->
-> (\+/)				:: (Ord a) => PairingHeap a -> PairingHeap a -> PairingHeap a
-> (\+/)				=  meldBy (<=)
->
-> meldBy			:: Rel a -> PairingHeap a -> PairingHeap a -> PairingHeap a
-> meldBy (<=) Empty u		=  u
-> meldBy (<=) t@(Node _ _) Empty=  t
-> meldBy (<=) t@(Node a ts) u@(Node b us)
->     | a <= b			=  Node a (u : ts)
->     | otherwise		=  Node b (t : us)
->
-> pairingSort			:: (Ord a) => [a] -> [a]
-> pairingSort			=  pairingSortBy (<=)
->
-> pairingSortBy			:: Rel a -> [a] -> [a]
-> pairingSortBy (<=)		=  unHeap . meldAll . map leaf
->     where
->     (\+/)			=  meldBy (<=)
-
-Different variants of pairing heaps differ in the implementation of
-|meldAll|.
-
->     meldAll []		=  Empty
->     meldAll [t]		=  t
->     meldAll (t1 : t2 : ts)	=  (t1 \+/ t2) \+/ meldAll ts
-
-Note that subsequent trees are first paired using |meld|, hence the
-name of the data structure.
-
->     unHeap Empty		=  []
->     unHeap (Node a ts)	=  a : unHeap (meldAll ts)
-
-What about the running time? Fredman et al~\cite{FSS86Pai} show that
-|meld| and |splitMin| run in $O(\log n)$ amortized time. Hence we have
-$O(n\log n)$ worst case behaviour. \NB Chris Okasaki has developed a
-persistent variant of pairing heaps~\cite{Oka96Fun} which might be
-worth trying, as well.
-
-The function |meldAll| corresponds to |foldr meld empty . pairfold
-meld|. Alternatively, one can make repeated passes over the trees using
-|treefold meld empty|.
-
-> mpPairingSort			:: (Ord a) => [a] -> [a]
-> mpPairingSort			=  mpPairingSortBy (<=)
->
-> mpPairingSortBy		:: Rel a -> [a] -> [a]
-> mpPairingSortBy (<=)		=  unHeap . meldAll . map leaf
->     where
->     meldAll			=  treefold (meldBy (<=)) Empty
->     unHeap Empty		=  []
->     unHeap (Node a ts)	=  a : unHeap (meldAll ts)
-
-Fredman et al~\cite{FSS86Pai} state that the multipass variant is not
-easy to analyse which is certainly true. They only succeeded in proving
-an $O(\log n\log\log n/\log\log\log n)$ bound on the amortized time per
-heap operation. Hence it is not clear whether |mpPairingSort| is an
-$O(n\log n)$ algorithm.
− Swish/HaskellRDF/Sort/QuickSort.lhs 
@@ -1,170 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Partioning sort}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.QuickSort
-> where
-> import Swish.HaskellRDF.Sort.MergeSort (mergeSortBy)
-> import Data.List
-> import Swish.HaskellRDF.Sort.LibBase
-
-%align 33
-
-%-------------------------------=  --------------------------------------------
-\section{Some variations of quick sort}
-%-------------------------------=  --------------------------------------------
-%format qsort1			=  qsort "_1"
-%format qsort2			=  qsort "_2"
-%format qsort3			=  qsort "_3"
-
-This section lists some variants of quick sort which \emph{cannot be
-recommended} for use. The first and probably the most popular of all
-appears in \cite[p.~154]{BiW88}, \cite[p.~128]{HinFun92},
-\cite[p.~433]{Tho96Has}, and \cite[p.~9]{HPF97Gen}.
-
-> qsort1			:: (Ord a) => [a] -> [a]
-> qsort1 []			=  []
-> qsort1 (p : as)		=  qsort1 [ a | a <- as, a < p ]
->				++ p : qsort1 [ a | a <- as, p <= a ]
-
-Its main purpose is probably to demonstrate the use and elegancy of
-list comprehensions. The definition has, however, several drawbacks
-part from the fact that quick sort is not asymptotically optimal.
-%
-\begin{enumerate}
-\item
-it traverses the list twice,
-
-\item
-it has a space leak: |as| is alive until the second traversal is done
-\cite[p.~18]{Bir96Fun},
-
-\item
-it uses |(++)| to catenate the results of the recursive calls (note that
-|(++)| takes time proportional to the length of its first argument).
-\end{enumerate}
-
-The second variant uses the library function |partition| to avoid the
-double traversal.
-
-> qsort2			:: (Ord a) => [a] -> [a]
-> qsort2 []			=  []
-> qsort2 (p : as)		=  qsort2 l ++ p : qsort2 r
->     where (l, r)		=  partition (< p) as
-
-And finally, here is a variant which employs a tail recursive partition
-function.
-
-> qsort3			:: (Ord a) => [a] -> [a]
-> qsort3 []			=  []
-> qsort3 [a]			=  [a]
-> qsort3 (p : as)		=  partition [] [] as
->     where
->     partition l r []		=  qsort3 l ++ p : qsort3 r
->     partition l r (a : as)
->         | p <= a 		=  partition l (a : r) as
->	  | otherwise		=  partition (a : l) r as
-
-Note however that |qsort3| is no longer stable since |l| and |r| are in
-reverse order.
-
-%-------------------------------=  --------------------------------------------
-\section{Paulson's quicksort}
-%-------------------------------=  --------------------------------------------
-
-The following code is adpated from \cite[p.~110]{Pau96ML}. The main
-difference to |qsort3| is that it uses an accumulating argument to
-eliminate the calls to |(++)|.
-
-> quickSort			:: (Ord a) => [a] -> [a]
-> quickSort			=  quickSortBy (<=)
->
-> quickSortBy			:: Rel a -> [a] -> [a]
-> quickSortBy (<=) as		=  qsort as []
->     where
->     qsort []       x		=  x
->     qsort [a]      x		=  a : x
->     qsort (p : as) x		=  partition [] [] as
->         where
->         partition l r []	=  qsort l (p : qsort r x)
->         partition l r (a : as)
->             | p <= a 		=  partition l (a : r) as
->	      | otherwise	=  partition (a : l) r as
-
-%-------------------------------=  --------------------------------------------
-\section{Augustsson's stable quicksort}
-%-------------------------------=  --------------------------------------------
-
-Neither |qsort3| nor |quickSort| is stable. This is due to the fact
-that partition reverses the order of elements (the lists |l| and |r|
-are used as a stack). By duplicating the code into a stable and an
-anti-stable variant we obtain stability.
-
-> stableQuickSort		:: (Ord a) => [a] -> [a]
-> stableQuickSort		=  stableQuickSortBy (<=)
->
-> stableQuickSortBy		:: Rel a -> [a] -> [a]
-> stableQuickSortBy (<=) as	=  qsortBy (<=) as []
->
-> qsortBy			:: Rel a -> [a] -> [a] -> [a]
-> qsortBy (<=) []       x 	=  x
-> qsortBy (<=) [a]      x	=  a : x
-> qsortBy (<=) (p : as) x	=  partition [] [] as
->     where
-
-The function |partition| partitions and sorts the sublists. Note that
-|l| and |r| are in reverse order and must be sorted with an anti-stable
-sorting.
-
->     partition l r []		=  rqsortBy (<=) l (p : rqsortBy (<=) r x)
->     partition l r (a : as)
->         | p <= a 		=  partition l (a : r) as
->	  | otherwise		=  partition (a : l) r as
-
-The function |rqsortBy| is as |qsort| but anti-stable, ie it reverses
-equal elements (compare the last two equations of |partition|).
-
-> rqsortBy			:: Rel a -> [a] -> [a] -> [a]
-> rqsortBy (<=) []       x 	=  x
-> rqsortBy (<=) [a]      x	=  a : x
-> rqsortBy (<=) (p : as) x	=  partition [] [] as
->     where
->     partition l r []		=  qsortBy (<=) l (p : qsortBy (<=) r x)
->     partition l r (a : as)
->         | a <= p 		=  partition (a : l) r as
->	  | otherwise		=  partition l (a : r) as
-
-%-------------------------------=  --------------------------------------------
-\section{Introspective quicksort}
-%-------------------------------=  --------------------------------------------
-
-One of the big disadvantages of quick sort is its quadratic worst-case
-behaviour. It turns out that it is quite easy to solve this dilemma:
-simply limit the recursion depth to a fixed bound, and for subproblems
-which exceed the limit use an $\Theta(n\lg n)$ algorithm
-\cite{Mus97Int}.
-
-> introSort			:: (Ord a) => [a] -> [a]
-> introSort			=  introSortBy (<=)
-
-> introSortBy			:: Rel a -> [a] -> [a]
-> introSortBy (<=) as		=  isort (2 * floorLg (length as)) as []
->   where
->   isort 0       as       x	=  mergeSortBy (<=) as ++ x
->   isort (d + 1) []       x	=  x
->   isort (d + 1) [a]      x	=  a : x
->   isort (d + 1) (p : as) x	=  partition [] [] as
->     where
->     partition l r []		=  isort d l (p : isort d r x)
->     partition l r (a : as)
->         | p <= a 		=  partition l (a : r) as
->         | otherwise		=  partition (a : l) r as
-
-Musser recommends a depth bound of |2*floor (lg n)|.
-
-> floorLg                       :: Int -> Int
-> floorLg n
->     | n == 1                  =  0
->     | otherwise               =  1 + floorLg (n `div` 2)
− Swish/HaskellRDF/Sort/RedBlackTree.lhs 
@@ -1,119 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Red-black trees}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.RedBlackTree 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-
-%align 33
-
-Every search tree scheme can be used for sorting: the elements are
-repeatedly inserted into an empty initial tree; an inorder traversal of
-the final tree yields the desired ordered permutation of the input.
-Here we use red-black trees as described by Chris Okasaki
-\cite[p.~24]{Oka98Pur}.
-
-Sorting on the basis of red-black trees is asymptotically optimal and
-stable but neither adpative nor lazy.
-
-> data RedBlackTree a		=  Empty
->				|  Red (RedBlackTree a) a (RedBlackTree a)
->				|  Black (RedBlackTree a) a (RedBlackTree a)
-
-\NB For reasons of efficiency nodes do not have a separate color field,
-instead the color is coded into the constructor.
-
-> insertBy			:: Rel a -> a -> RedBlackTree a -> RedBlackTree a
-> insertBy (<=) a t		=  blacken (ins t)
->   where ins Empty		=  Red Empty a Empty
->         ins (Red l b r)
->             | a <= b		=  Red (ins l) b r
->             | otherwise	=  Red l b (ins r)
->         ins (Black l b r)
->             | a <= b		=  lblack (ins l) b r
->             | otherwise	=  rblack l b (ins r)
->
-> blacken			:: RedBlackTree a -> RedBlackTree a
-> blacken (Red l a r)		=  Black l a r
-> blacken t			=  t
-
-%align 49
-{\setlength{\lwidth}{\lwidth + 1cm}
-
-> lblack					:: RedBlackTree a -> a -> RedBlackTree a -> RedBlackTree a
-> lblack (Red (Red t1 a1 t2) a2 t3) a3 t4	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
-> lblack (Red t1 a1 (Red t2 a2 t3)) a3 t4	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
-> lblack l a r					=  Black l a r
->
-> rblack					:: RedBlackTree a -> a -> RedBlackTree a -> RedBlackTree a
-> rblack t1 a1 (Red (Red t2 a2 t3) a3 t4)	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
-> rblack t1 a1 (Red t2 a2 (Red t3 a3 t4))	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
-> rblack l a r					=  Black l a r
-
-}
-%align 33
-
-> inorder			:: RedBlackTree a -> [a]
-> inorder t			=  traverse t []
->     where
->     traverse Empty x		=  x
->     traverse (Red l a r) x	=  traverse l (a : traverse r x)
->     traverse (Black l a r) x	=  traverse l (a : traverse r x)
->
-> redBlackSort			:: (Ord a) => [a] -> [a]
-> redBlackSort			=  redBlackSortBy (<=)
->
-> redBlackSortBy		:: Rel a -> [a] -> [a]
-> redBlackSortBy (<=)		=  inorder . foldr (insertBy (<=)) Empty
-
-
-Note that |lblack| and |rblack| sometimes perform an unnecessary test
-since both subtrees are tested for red-red violations. Here is a
-variant of |insertBy| which remedies this shortcoming, albeit at the
-expense of readability (this solves exercise~3.10(b) in
-\cite{Oka98Pur}, the original version already solves
-exercise~3.10(a)).
-
-> insertBy'			:: Rel a -> a -> RedBlackTree a -> RedBlackTree a
-> insertBy' (<=) a t		=  blacken (ins t)
->     where
->     ins Empty			=  Red Empty a Empty
->     ins (Red l b r)		=  error "red node"
->     ins (Black l b r)		=  black l b r
->
->     black l b r
->       | a <= b		=  case l of
->         Empty			-> Black (Red Empty a Empty) b r
->         Red ll lb lr
->           | a <= lb		-> case ins ll of
->             Red lll llb llr	-> Red (Black lll llb llr) lb (Black lr b r)
->             ll'		-> Black (Red ll' lb lr) b r
->           | otherwise		-> case ins lr of
->             Red lrl lrb lrr	-> Red (Black ll lb lrl) lrb (Black lrr b r)
->             lr'		-> Black (Red ll lb lr') b r
->         Black ll lb lr	-> Black (black ll lb lr) b r
->       | otherwise		=  case r of
->         Empty			-> Black l b (Red Empty a Empty)
->         Red rl rb rr
->           | a <= rb		-> case ins rl of
->             Red rll rlb rlr	-> Red (Black l b rll) rlb (Black rlr rb rr)
->             rl'		-> Black l b (Red rl' rb rr)
->           | otherwise		-> case ins rr of
->             Red rrl rrb rrr	-> Red (Black l a rl) rb (Black rrl rrb rrr)
->             rr'		-> Black l b (Red rl rb rr')
->         Black ll lb lr	-> Black l b (black ll lb lr)
->
-> redBlackSort'			:: (Ord a) => [a] -> [a]
-> redBlackSort'			=  redBlackSortBy (<=)
->
-> redBlackSortBy'		:: Rel a -> [a] -> [a]
-> redBlackSortBy' (<=)		=  inorder . foldr (insertBy' (<=)) Empty
-
-Empirical tests show that the decrease in readability is not justified
-or counterbalanced by an increase in speed: |redBlackSort'| is
-sometimes marginally faster, and sometimes marginally slower.
-\Todo{Curiously, |redBlackSort'| outperforms |redBlackSort| on strictly
-increasing sequences thereby contradicting the theory.}
− Swish/HaskellRDF/Sort/SplaySort.lhs 
@@ -1,63 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Splay sort}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.SplaySort 
-> where
-> import Swish.HaskellRDF.Sort.LibBase
-
-%align 33
-
-Sorting on the basis on splay trees has most of the desired features:
-is asymptotically optimal, stable and it adapts to the input. In fact,
-it has been conjectured \cite{MEP96Spl} that it is optimatically
-adaptive to all accepted measures of presortedness. The following code
-is due to Chris Okasaki \cite[p.~46]{Oka98Pur}.
-
-> data SplayTree a 		=  Empty
->				|  Bin (SplayTree a) a (SplayTree a)
->
-> insertBy			:: Rel a -> a -> SplayTree a -> SplayTree a
-> insertBy (<=) a t		=  Bin lt a ge
->    where (lt, ge)		=  partBy (<=) a t
-
-\NB |lt| means \U{l}ess \U{t}han and |ge| means \U{g}reater \U{e}qual.
-
-> partBy			:: Rel a -> a -> SplayTree a -> (SplayTree a, SplayTree a)
-> partBy (<=) k Empty		=  (Empty, Empty)
-> partBy (<=) k t@(Bin l a r)
->    | k <= a			=  case l of
->         Empty			-> (Empty, t)
->         Bin ll la lr
->             | k <= la		-> let (lt, ge) = partBy (<=) k ll in (lt, Bin ge la (Bin lr a r))
->             | otherwise	-> let (lt, ge) = partBy (<=) k lr in (Bin ll la lt, Bin ge a r)
->     | otherwise		=  case r of
->         Empty			-> (t, Empty)
->         Bin rl ra rr
->             | k <= ra		-> let (lt, ge) =  partBy (<=) k rl in (Bin l a lt, Bin ge ra rr)
->             | otherwise	-> let (lt, ge) =  partBy (<=) k rr in (Bin (Bin l a rl) ra lt, ge)
-
-\NB Throughout the library great care is taken to ensure that the
-relative order of equal elements is preserved. This is most easily
-accomplished if the order of the arguments to a function reflects the
-original order within the input. Consider, for example, the definition
-of |insertBy|: on the left hand side |a| appears before |t|, on the
-right hand side |a| appears before |ge| which may contain elements
-equal to |a|. Thus, the relative order of equal elements is preserved.
-That said, it is probably clear which we use |foldr| instead of |foldl|
-for building trees.
-
-> inorder			:: SplayTree a -> [a]
-> inorder t			=  traverse t []
->     where
->     traverse Empty x		=  x
->     traverse (Bin l a r) x	=  traverse l (a : traverse r x)
->
-> splaySort			:: (Ord a) => [a] -> [a]
-> splaySort			=  splaySortBy (<=)
->
-> splaySortBy			:: Rel a -> [a] -> [a]
-> splaySortBy (<=)		=  inorder . foldr (insertBy (<=)) Empty
-
− Swish/HaskellRDF/Sort/Squiggol.lhs 
@@ -1,53 +0,0 @@-%-------------------------------=  --------------------------------------------
-\chapter{Squiggol}
-%-------------------------------=  --------------------------------------------
-
-%align
-
-> module Swish.HaskellRDF.Sort.Squiggol (module Swish.HaskellRDF.Sort.Squiggol)
-> where
-> import Swish.HaskellRDF.Sort.ListLib (halve)
-> import Swish.HaskellRDF.Sort.MergeSort (merge)
-
-%align 33
-%format (cata (x))              = "\llparenthesis " x "\rrparenthesis "
-%format (ana (x))               = "\llbracket " x "\rrbracket "
-%format phi                     = "\varphi "
-%format psi                     = "\psi "
-%format (In (a))		=  a
-
-The squiggol approach to sorting.
-
-> newtype Mu f			=  In (f (Mu f))
->
-> cata				:: (Functor f) => (f a -> a) -> Mu f -> a
-> cata phi (In x)		=  phi (fmap (cata phi) x)
->
-> ana				:: (Functor f) => (a -> f a) -> a -> Mu f
-> ana psi x			=  In (fmap (ana psi) (psi x))
->
-> data Cell a list		=  Nil | Cons a list
->
-> type List a			=  Mu (Cell a)
-
-> data Node a bush		=  Empty | Leaf a | Fork bush bush
->
-> instance Functor (Node a) where
->     fmap f Empty		=  Empty
->     fmap f (Leaf a)		=  Leaf a
->     fmap f (Fork b1 b2)	=  Fork (f b1) (f b2)
->
-> type Bush a			=  Mu (Node a)
-
-> mergeSort			:: (Ord a) => [a] -> [a]
-> mergeSort			=  cata join . ana split
-
-> split				:: [a] -> Node a [a]
-> split []			=  Empty
-> split [a]			=  Leaf a
-> split as			=  uncurry Fork (halve as)
-
-> join				:: (Ord a) => Node a [a] -> [a]
-> join Empty			=  []
-> join (Leaf a)			=  [a]
-> join (Fork l r)		=  merge l r
− Swish/HaskellRDF/Sort/Stable.lhs 
@@ -1,58 +0,0 @@-> module Swish.HaskellRDF.Sort.Stable (module Swish.HaskellRDF.Sort.Stable)
-> where
-> import Data.List (group)
-> import Swish.HaskellRDF.Sort.ListLib
-> import Swish.HaskellRDF.Sort.LibBase
-> import Swish.HaskellRDF.Sort.PairingHeap
-
-Datentypen, um Stabilit"at zu testen.
-
-> data With a b                 =  a :- b
->                               deriving (Show)
->
-> sat				:: With a b -> b
-> sat (_ :- s)			=  s
-
-> instance (Eq a) => Eq (With a b) where
->     a :- _ == b :- _          =  a == b
->
-> instance (Ord a) => Ord (With a b) where
->     a :- _ <= b :- _          =  a <= b
-
-> number			:: (Enum b, Num b) => [a] -> [With a b]
-> number as			=  [ a :- i | (a, i) <- zip as [1 ..] ]
-
-> isStable			:: (Num a, Num b, Enum b, Eq c, Ord d)
->				=> ([With a b] -> [With c d]) -> [([a],[With c d])]
-> isStable sort			=  [ (as, s)
->				   | as <- perms [1, 1, 2, 2, 2],
->				     let as' = number as,
->				     let s = sort as',
->				     not (stable s) ]
-
-> stable			:: (Eq a, Ord b) => [With a b] -> Bool
-> stable as			=  and [ ordered (map sat g) | g <- group as ]
-
-%if False
-
-> {-
-> data A			=  A1 | A2 | A3
->
-> instance Eq A where
->     _ == _			=  True
->
-> instance Ord A where
->     compare _ _		=  EQ
-
-> eq A1 A1			=  True
-> eq A2 A2			=  True
-> eq A3 A3			=  True
-> eq _ _			=  False
->
-> equal as1 as2			=  and [ eq a1 a2 | (a1, a2) <- zip as1 as2 ]
-
-[ (as, s) | as <- perms [A1, A2, A3], let s = heapSort as, not (equal as s) ]
-
-> -}
-
-%endif
− Swish/HaskellRDF/Swish.hs 
@@ -1,122 +0,0 @@---------------------------------------------------------------------------------
---  $Id: Swish.hs,v 1.11 2004/01/09 14:36:33 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Swish
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module is a wrapper for the main program of Swish.
---
---------------------------------------------------------------------------------
-
---     WNH RIP OUT module Swish.HaskellRDF.Swish where
--- module Main where      WNH RIP OUT!!!!-
-import Swish.HaskellRDF.SwishMain
---import System.Environment-       ( getArgs )--import System.Exit
-    ( ExitCode(ExitSuccess,ExitFailure), exitWith )
-
--------------------------------------------------------------
---  Swish main program
-------------------------------------------------------------
---
---  This is a minimal wrapper for the real main program, to facilitate
---  interactive execution (e.g. in HUGS) of different command lines.
---
---  execStateT runs the monad with a supplied initial state,
---  then separates the resulting state from the IO monad.
-
-main :: IO ()
-main =
-    do  { -          putStrLn ("Swish-0.2.1 CLI\n\n")-        ;-          args <- getArgs
-        ; code <- runSwishArgs args
-        ; if code == ExitSuccess then
-            return ()
-          else
-          if code == (ExitFailure 1) then
-            putStrLn $ "Swish: graphs compare different"
-          else
-            putStrLn $ "Swish: "++show code
-        ; exitWith code
-        }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Swish.hs,v $
--- $Author: graham $
--- $Revision: 1.11 $
--- $Log: Swish.hs,v $
--- Revision 1.11  2004/01/09 14:36:33  graham
--- Revert Swish.hs and Sw3ishtestAll.hs to declare module Main.
--- GHC compilation without -main-is option.  Tests OK.
---
--- Revision 1.10  2004/01/06 16:29:56  graham
--- Fix up module exports to avoid GHC warnings
---
--- Revision 1.9  2003/09/24 18:50:53  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.8  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.7  2003/05/29 12:39:49  graham
--- Improved error handling for stand-alone swish program
---
--- Revision 1.6  2003/05/29 11:52:41  graham
--- Juggle Swish code:  SwishMain.hs is main program logic, with
--- Swish.hs and SwishTest.hs being alternative "Main" modules for
--- the real program and test harness respectively.
---
--- Revision 1.5  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.4  2003/05/23 00:02:42  graham
--- Fixed blank node id generation bug in N3Formatter
---
--- Revision 1.3  2003/05/21 13:34:13  graham
--- Various N3 parser bug fixes.
--- Need to fix handling of :name terms.
---
--- Revision 1.2  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.1  2003/05/20 17:30:48  graham
--- Initial swish program skeleton runs using isolated tests under Hugs
---
− Swish/HaskellRDF/SwishCommands.hs 
@@ -1,451 +0,0 @@---------------------------------------------------------------------------------
---  $Id: SwishCommands.hs,v 1.14 2004/02/11 14:19:36 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  SwishCommands
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  SwishCommands:  functions to deal with indivudual Swish command options.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.SwishCommands
-    ( swishFormat
-    , swishInput
-    , swishOutput
-    , swishMerge
-    , swishCompare
-    , swishGraphDiff
-    , swishScript
-    )
-where
-
-import Swish.HaskellRDF.SwishMonad
-    ( SwishStateIO, SwishState(..)
-    , setFormat, setGraph
-    , resetInfo, resetError, setExitcode
-    , SwishFormat(..)
-    , swishError
-    , reportLine-    )
-
-import Swish.HaskellRDF.SwishScript
-    ( parseScriptFromString
-    )
-
-import Swish.HaskellRDF.GraphPartition
-    ( GraphPartition(..)
-    , partitionGraph, comparePartitions
-    , partitionShowP
-    )
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph, merge )
-
-import Swish.HaskellRDF.N3Formatter
-    ( formatGraphAsShowS )
-
-import Swish.HaskellRDF.N3Parser
-    ( parseN3fromString )
-
-import Swish.HaskellRDF.GraphClass
-    ( LDGraph(..)
-    , Label(..)
-    )
-
-import Swish.HaskellUtils.ErrorM( ErrorM(..) )
-
-import System.IO
-    ( Handle, openFile, IOMode(..)
-    , hPutStr, hPutStrLn, hClose, hGetContents
-    , hIsReadable, hIsWritable
-    , stdin, stdout, stderr
-    )
-
-import Control.Monad.Trans( MonadTrans(..) )
-
-import Control.Monad.State
-    ( modify, gets
-    )
-
-import Data.Maybe
-    ( Maybe(..), isJust, fromJust )
-
-import Control.Monad
-    ( when )
--import System.Exit
-    ( ExitCode(..) )
-
-import System.IO.Error--------------------------------------------------------------
---  Set file format to supplied value
-------------------------------------------------------------
-
-swishFormat :: SwishFormat -> SwishStateIO ()
-swishFormat fmt = modify $ setFormat fmt
-
-------------------------------------------------------------
---  Read graph from named file
-------------------------------------------------------------
-
-swishInput :: String -> SwishStateIO ()
-swishInput fnam =
-    do  { maybegraph <- swishReadGraph fnam
-        ; case maybegraph of
-            Just g    -> modify $ setGraph g
-            _         -> return ()
-        }
-
-------------------------------------------------------------
---  Merge graph from named file
-------------------------------------------------------------
-
-swishMerge :: String -> SwishStateIO ()
-swishMerge fnam =
-    do  { maybegraph <- swishReadGraph fnam
-        ; case maybegraph of
-            Just g    -> modify $ mergeGraph g
-            _         -> return ()
-        }
-
-mergeGraph gr state = state { graph = newgr }
-    where
-        newgr = merge gr (graph state)
-
-------------------------------------------------------------
---  Compare graph from named file
-------------------------------------------------------------
-
-swishCompare :: String -> SwishStateIO ()
-swishCompare fnam =
-    do  { maybegraph <- swishReadGraph fnam
-        ; case maybegraph of
-            Just g    -> compareGraph g
-            _         -> return ()
-        }
-
-compareGraph :: RDFGraph -> SwishStateIO ()
-compareGraph gr =
-    do  { oldgr <- gets graph
-        ; let exitCode = if gr == oldgr then ExitSuccess
-                                        else ExitFailure 1
-        ; modify $ setExitcode exitCode
-        }
-
-------------------------------------------------------------
---  Display graph differences from named file
-------------------------------------------------------------
-
-swishGraphDiff :: String -> SwishStateIO ()
-swishGraphDiff fnam =
-    do  { maybegraph <- swishReadGraph fnam
-        ; case maybegraph of
-            Just g    -> diffGraph g
-            _         -> return ()
-        }
-
-diffGraph :: RDFGraph -> SwishStateIO ()
-diffGraph gr =
-    do  { oldgr <- gets graph
-        ; let p1 = partitionGraph (getArcs oldgr)
-        ; let p2 = partitionGraph (getArcs gr)
-        ; let diffs = comparePartitions p1 p2
-        ; maybehandleclose <- swishWriteFile "" -- null filename -> stdout
-        ; case maybehandleclose of
-            Just (h,c) ->
-                do  { swishOutputDiffs "" h diffs
-                    ; if c then lift $ hClose h else return ()
-                    }
-            _          -> return ()
-        }
-
-swishOutputDiffs :: (Label lb) =>
-    String -> Handle
-    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-    -> SwishStateIO ()
-swishOutputDiffs fnam hnd diffs =
-    do  { lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))
-        ; sequence_ $ map (swishOutputDiff fnam hnd) (zip [1..] diffs)
-        }
-
-swishOutputDiff :: (Label lb) =>
-    String -> Handle
-    -> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb)))
-    -> SwishStateIO ()
-swishOutputDiff fnam hnd (diffnum,(part1,part2)) =
-    do  { lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")
-        ; lift $ hPutStr hnd "Graph 1:"
-        ; swishOutputPart fnam hnd part1
-        ; lift $ hPutStr hnd "Graph 2:"
-        ; swishOutputPart fnam hnd part2
-        }
-
-swishOutputPart :: (Label lb) =>
-    String -> Handle -> Maybe (GraphPartition lb) -> SwishStateIO ()
-swishOutputPart fnam hnd part =
-    do  { let out = case part of
-                Just p  -> partitionShowP "\n" p
-                Nothing -> "\n(No arcs)"
-        ; lift $ hPutStrLn hnd out
-        }
-
-------------------------------------------------------------
---  Execute script from named file
-------------------------------------------------------------
-
-swishScript :: String -> SwishStateIO ()
-swishScript fnam =
-    do  { scs <- swishReadScript fnam
-        ; sequence_ (map swishCheckResult scs)
-        }
-
-swishReadScript :: String -> SwishStateIO [SwishStateIO ()]
-swishReadScript fnam =
-    do  { maybefile <- swishOpenFile fnam
-        ; case maybefile of
-            Just (h,i) ->
-                do  { res <- swishParseScript fnam i
-                    ; lift $ hClose h
-                    ; return res
-                    }
-            _          -> return []
-        }
-
-swishParseScript ::
-    String -> String -> SwishStateIO [SwishStateIO ()]
-swishParseScript fnam inp =
-    do  { let base = if null fnam then Nothing else Just fnam
-        ; let sres = parseScriptFromString base inp
-        ; case sres of
-            Error err ->
-                do  { swishError ("Script syntax error in file "++fnam++": "++err) 2
-                    ; return []
-                    }
-            Result scs -> return scs
-        }
-
-swishCheckResult :: SwishStateIO () -> SwishStateIO ()
-swishCheckResult swishcommand =
-    do  { swishcommand
-        ; er <- gets errormsg
-        ; when (isJust er) $
-            do  { swishError (fromJust er) 5
-                ; modify $ resetError
-                }
-        ; ms <- gets infomsg
-        ; when (isJust ms) $
-            do  { reportLine (fromJust ms)
-                ; modify $ resetInfo
-                }
-        }
-
-------------------------------------------------------------
---  Output graph to named file
-------------------------------------------------------------
-
-swishOutput :: String -> SwishStateIO ()
-swishOutput fnam =
-    do  { maybehandleclose <- swishWriteFile fnam
-        ; case maybehandleclose of
-            Just (h,c) ->
-                do  { swishOutputGraph fnam h
-                    ; if c then lift $ hClose h else return ()
-                    }
-            _          -> return ()
-        }
-
-swishOutputGraph :: String -> Handle -> SwishStateIO ()
-swishOutputGraph fnam hnd =
-    do  { fmt <- gets $ format
-        ; case fmt of
-            N3        -> swishFormatN3 fnam hnd
-            _         -> swishError
-                         ("Unsupported file format: "++(show fmt)) 4
-        }
-
-swishFormatN3 :: String -> Handle -> SwishStateIO ()
-swishFormatN3 fnam hnd =
-    do  { out <- gets $ formatGraphAsShowS . graph
-        ; lift $ hPutStr hnd (out "")
-        }
-
-------------------------------------------------------------
---  Common input functions
-------------------------------------------------------------
---
---  Keep the logic separate for reading file data and
---  parsing it to an RDF graph value.
-
-swishReadGraph :: String -> SwishStateIO (Maybe RDFGraph)
-swishReadGraph fnam =
-    do  { maybefile <- swishOpenFile fnam
-        ; case maybefile of
-            Just (h,i) ->
-                do  { res <- swishParse fnam i
-                    ; lift $ hClose h
-                    ; return res
-                    }
-            _          -> return Nothing
-        }
-
--- Open and read file, returning its handle and content, or Nothing
--- WARNING:  the handle must not be closed until input is fully evaluated
-swishOpenFile :: String -> SwishStateIO (Maybe (Handle,String))
-swishOpenFile fnam =
-    do  { (hnd,hop) <- lift $
-            if null fnam then
-                return (stdin,True)
-            else
-            do  { o <- try (openFile fnam ReadMode)
-                ; case o of
-                    Left  e -> return (stdin,False)
-                    Right h -> return (h,True)
-                }
-        ; hrd <- lift $ hIsReadable hnd
-        ; res <- if hop && hrd then
-            do  {
-                ; fc <- lift $ hGetContents hnd
-                ; return $ Just (hnd,fc)
-                }
-            else
-            do  { lift $ hClose hnd
-                ; swishError ("Cannot read file: "++fnam) 3
-                ; return Nothing
-                }
-        ; return res
-        }
-
-swishParse :: String -> String -> SwishStateIO (Maybe RDFGraph)
-swishParse fnam inp =
-    do  { fmt <- gets $ format
-        ; case fmt of
-            N3        -> swishParseN3 fnam inp
-            _         ->
-                do  { swishError ("Unsupported file format: "++(show fmt)) 4
-                    ; return Nothing
-                    }
-        }
-
-swishParseN3 :: String -> String -> SwishStateIO (Maybe RDFGraph)
-swishParseN3 fnam inp =
-    do  { let pres = parseN3fromString inp
-        ; case pres of
-            Error err ->
-                do  { swishError ("N3 syntax error in file "++fnam++": "++err) 2
-                    ; return Nothing
-                    }
-            Result gr -> return $ Just gr
-        }
-
---  Open file for writing, returning its handle, or Nothing
---  Also returned is a flag indicating whether or not the
---  handled should be closed when writing is done (if writing
---  to standard output, the handle should not be closed as the
---  run-time system should deal with that).
-swishWriteFile :: String -> SwishStateIO (Maybe (Handle,Bool))
-swishWriteFile fnam =
-    do  { (hnd,hop,cls) <- lift $
-            if null fnam then
-                return (stdout,True,False)
-            else
-            do  { o <- try (openFile fnam WriteMode)
-                ; case o of
-                    Left  e -> return (stderr,False,False)
-                    Right h -> return (h,True,True)
-                }
-        ; hwt <- lift $ hIsWritable hnd
-        ; if hop && hwt then
-                return $ Just (hnd,cls)
-            else
-            do  { if cls then lift $ hClose hnd else return ()
-                ; swishError ("Cannot write file: "++fnam) 3
-                ; return Nothing
-                }
-        }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/SwishCommands.hs,v $
--- $Author: graham $
--- $Revision: 1.14 $
--- $Log: SwishCommands.hs,v $
--- Revision 1.14  2004/02/11 14:19:36  graham
--- Add graph-difference option to Swish
---
--- Revision 1.13  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.12  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.11  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.10  2003/12/01 18:51:38  graham
--- Described syntax for Swish script.
--- Created Swish scripting test data.
--- Edited export/import lists in Swish main program modules.
---
--- Revision 1.9  2003/09/24 18:50:53  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.8  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.7  2003/05/29 12:39:49  graham
--- Improved error handling for stand-alone swish program
---
--- Revision 1.6  2003/05/29 10:49:08  graham
--- Added and tested merge option (-m) for Swish program
---
--- Revision 1.5  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.4  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.3  2003/05/23 00:03:55  graham
--- Added HUnit test module for swish program.
--- Greatly enhanced N3Formatter tests
---
--- Revision 1.2  2003/05/21 13:34:13  graham
--- Various N3 parser bug fixes.
--- Need to fix handling of :name terms.
---
--- Revision 1.1  2003/05/20 23:36:30  graham
--- Add new Swish modules
---
− Swish/HaskellRDF/SwishMain.hs 
@@ -1,273 +0,0 @@---------------------------------------------------------------------------------
---  $Id: SwishMain.hs,v 1.15 2004/02/11 17:37:02 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  SwishMain
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  Swish:  Semantic Web Inference Scripting in Haskell
---
---  This program is a simple skeleton for constructing Semantic Web [1]
---  inference tools in Haskell, using the RDF graph, Notation 3 parser
---  and Notation 3 formatter modules.
---
---  It might be viewed as a kind of embroyonic CWM [2] in Haskell, except
---  that the intent is that Haskell will be used as a primary language for
---  defining inferences.  As such, Swish is an open-ended toolkit for
---  constructing new special-purpose Semantic Web applications rather
---  than a closed, self-contained general-purpose SW application.
---  I anticipate that this module may be used as a starting point for
---  creating new programs rathar then as a complete program in its own right.
---  The functionality built into this code is selected with a view to testing
---  the Haskell modules for handling RDF rather than for performing any
---  particular application processing (though development as a tool with
---  some broader utility is not ruled out).  As such, it is part of
---  another experiment along the lines described in [3].
---
---  [1] Semantic werb: http://www.w3.org/2001/sw/
---  [2] CWM:           http://www.w3.org/2000/10/swap/doc/cwm.html
---  [3] Motivation:    http://www.w3.org/2000/10/swap/doc/Motivation.html
---  [4] Notation 3:    http://www.w3.org/DesignIssues/Notation3.html
---  [5] RDF:           http://www.w3.org/RDF/
---
---  For command line details, see 'usageText' below.
---
---  TODO:
---  + Add RDF/XML input and output
---  + Add N-triples input and output
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.SwishMain(runSwish,runSwishArgs) where
-
-import Swish.HaskellRDF.SwishCommands
-    ( swishFormat
-    , swishInput
-    , swishOutput
-    , swishMerge
-    , swishCompare
-    , swishGraphDiff
-    , swishScript
-    )
-
-import Swish.HaskellRDF.SwishMonad
-    ( SwishStateIO, SwishState(..)
-    , emptyState
-    , SwishFormat(..)
-    , swishError
-    , reportLines 
-    )
-
-import Swish.HaskellUtils.ListHelpers
-    ( breakAll )
-
-import Control.Monad.State
-    ( execStateT )
-
-import Data.Char
-    ( isSpace )
-
-import Control.Monad
-    ( when )
-
-import System.Exit
-    ( ExitCode(ExitSuccess) )
-
-------------------------------------------------------------
---  Command line description
-------------------------------------------------------------
-
-usageText :: [[Char]]-usageText =
-    [ "Swish 0.2.1"
-    , "Read, merge, write, compare and process RDF graphs."
-    , ""
-    , "Usage: swish option option ..."
-    , ""
-    , "where the options are processed from left to right, and may be"
-    , "any of the following:"
-    , "-?        display this message."
-    , "-n3       use Notation3 format for subsequent input and output."
-    , "-i[=file] read file in selected format into the graph workspace,"
-    , "          replacing any existing graph."
-    , "-m[=file] merge file in selected format with the graph workspace."
-    , "-c[=file] compare file in selected format with the graph workspace."
-    , "-d[=file] show graph differences between the file in selected"
-    , "          format and the graph workspace.  Differences are displayed"
-    , "          to the standard output stream."
-    , "-o[=file] write the graph workspace to a file in the selected format."
-    , "-s[=file] read and execute Swish script commands from the named file."
-    , ""
-    , "    If an optional filename value is omitted, the standard input"
-    , "    or output stream is used, as appropriate."
-    , ""
-    , "Exit status codes:"
-    , "Success - operation completed successfully/graphs compare equal"
-    , "1 - graphs compare different"
-    , "2 - input data format error"
-    , "3 - file access problem"
-    , "4 - command line error"
-    , "5 - script file execution error"
-    , ""
-    , "Examples:"
-    , ""
-    , "swish -n3 -i=file"
-    , "    read file as Notation3, and report any syntax errors."
-    , "swich -n3 -i=file1 -c=file2"
-    , "    read file1 and file2 as notation3, report any syntax errors, and"
-    , "    if both are OK, compare the resulting graphs to indicate whether"
-    , "    or not they are equivalent."
-    , "swish -n3 -i=file1 -o=file2"
-    , "    read file1 as Notation3, report any syntax errors, and output the"
-    , "    resulting graph as reformatted Notation3.  (The output may be"
-    , "    unedifying, but is intended to be used to test round-tripping"
-    , "    of Notation 3 data.  The Notation3 formatter may be improved in"
-    , "    subsequent versions.)"
-    ]
-
-------------------------------------------------------------
---  Swish command line interpreter
-------------------------------------------------------------
---
---  This is a composite monad combining some state with an IO
---  Monad.  "lift" allows a pure IO monad to be used as a step
---  of the computation.
---
---  sequence_ is a Monad sequencer, returning a new monad that
---  executes members of a list in turn, passing state along the
---  chain.
---
-swishCommands :: [String] -> SwishStateIO ()
-swishCommands args =
-    do  { sequence_ (map swishCommand args)
-        }
-
-swishCommand :: String -> SwishStateIO ()
-swishCommand cmd =
-        let
-            (nam,more) = break (=='=') cmd
-            arg        = drop 1 more
-        in
-        case nam of
-            ""      -> return ()    -- do nothing
-            "-?"    -> swishHelp
-            "-n3"   -> swishFormat N3
-            "-i"    -> swishInput arg
-            "-m"    -> swishMerge arg
-            "-c"    -> swishCompare arg
-            "-d"    -> swishGraphDiff arg
-            "-o"    -> swishOutput arg
-            "-s"    -> swishScript arg
-            _       -> swishError ("Invalid command line element: "++cmd) 4
-
-swishHelp :: SwishStateIO ()
-swishHelp = reportLines usageText
-
-------------------------------------------------------------
---  Interactive test function (e.g. for use in Hugs)
-------------------------------------------------------------
-
-runSwish :: String -> IO ExitCode
-runSwish cmdline =
-    do  { let args = breakAll isSpace cmdline
-        ; ec <- runSwishArgs args
-        ; when (ec /= ExitSuccess) (putStrLn $ "Swish exit: "++show ec)
-        ; return ec
-        }
-
-runSwishArgs :: [String] -> IO ExitCode
-runSwishArgs args =
-    do  { state <- execStateT (swishCommands args) emptyState
-        ; return $ exitcode state
-        }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/SwishMain.hs,v $
--- $Author: graham $
--- $Revision: 1.15 $
--- $Log: SwishMain.hs,v $
--- Revision 1.15  2004/02/11 17:37:02  graham
--- Update for Swish 0.2.1
---
--- Revision 1.14  2004/02/11 14:19:36  graham
--- Add graph-difference option to Swish
---
--- Revision 1.13  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.12  2003/12/20 17:07:48  graham
--- Display swish version number in usage message
---
--- Revision 1.11  2003/12/20 14:34:21  graham
--- Update command line options help message.
---
--- Revision 1.10  2003/12/19 21:29:33  graham
--- Minor edits
---
--- Revision 1.9  2003/12/19 16:34:12  graham
--- Add 'test' function to run SwishTest script
---
--- Revision 1.8  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.7  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.6  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.5  2003/12/01 18:51:38  graham
--- Described syntax for Swish script.
--- Created Swish scripting test data.
--- Edited export/import lists in Swish main program modules.
---
--- Revision 1.4  2003/09/24 18:50:53  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.3  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.2  2003/05/29 12:39:49  graham
--- Improved error handling for stand-alone swish program
---
--- Revision 1.1  2003/05/29 11:52:41  graham
--- Juggle Swish code:  SwishMain.hs is main program logic, with
--- Swish.hs and SwishTest.hs being alternative "Main" modules for
--- the real program and test harness respectively.
− Swish/HaskellRDF/SwishMonad.hs 
@@ -1,306 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}-{-# OPTIONS -XMultiParamTypeClasses #-}---------------------------------------------------------------------------------
---  $Id: SwishMonad.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  SwishMonad
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  SwishMonad:  Composed state and IO monad for Swish
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.SwishMonad
-    ( SwishStateIO, SwishState(..)
-    , setFormat, setGraph
-    , modGraphs, findGraph, findFormula
-    , modRules, findRule
-    , modRulesets, findRuleset
-    , findOpenVarModify, findDatatype
-    , setInfo, resetInfo, setError, resetError, setExitcode
-    , emptyState
-    , SwishFormat(..)
-    , NamedGraph(..)
-    , swishError
-    , reportLines, reportLine
-    )
-where
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph, emptyRDFGraph )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule, RDFRuleMap, RDFRuleset, RDFRulesetMap )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFOpenVarBindingModify
-    )
-
-import Swish.HaskellRDF.BuiltInMap
-    ( findRDFOpenVarBindingModifier
-    , findRDFDatatype
-    , rdfRulesetMap
-    )
-
-import Swish.HaskellRDF.Ruleset
-    ( getMaybeContextAxiom
-    , getMaybeContextRule
-    )
-
-import Swish.HaskellRDF.Rule
-    ( Formula(..)-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , emptyLookupMap
-    , mapFindMaybe
-    , mapVals
-    )
-
-import Control.Monad.Trans
-    ( MonadTrans(..) )
-
-import Control.Monad.State
-    ( modify, StateT(..))
-
-import System.Exit
-    ( ExitCode(ExitSuccess,ExitFailure) )
-
-import System.IO
-    ( hPutStrLn, stderr )
-
-------------------------------------------------------------
---  State and state monad for Swish program
-------------------------------------------------------------
---
---  Uses StateT Monad transformer:
---  See example by Mark Carroll at http://www.haskell.org/hawiki/MonadState
-
-data SwishFormat = N3 | NT | RDF
-    deriving (Eq, Show)
-
-data SwishState = SwishState
-    { format    :: SwishFormat
-    , graph     :: RDFGraph         -- current graph
-    , graphs    :: NamedGraphMap    -- script processor named graphs
-    , rules     :: RDFRuleMap       -- script processor named rules
-    , rulesets  :: RDFRulesetMap    -- script processor rulesets
-    , infomsg   :: Maybe String     -- information message, or Nothing
-    , errormsg  :: Maybe String     -- error message, or Nothing
-    , exitcode  :: ExitCode
-    }
-
-type SwishStateIO a = StateT SwishState IO a
-
-emptyState :: SwishState-emptyState = SwishState
-    { format    = N3
-    , graph     = emptyRDFGraph
-    , graphs    = emptyLookupMap
-    , rules     = emptyLookupMap
-    , rulesets  = rdfRulesetMap
-    , infomsg   = Nothing
-    , errormsg  = Nothing
-    , exitcode  = ExitSuccess
-    }
-
-setFormat :: SwishFormat -> SwishState -> SwishState
-setFormat   fm state = state { format = fm }
-
-setGraph :: RDFGraph -> SwishState -> SwishState
-setGraph    gr state = state { graph = gr }
-
-modGraphs ::
-    ( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
-modGraphs grmod state = state { graphs = grmod (graphs state) }
-
-findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]
-findGraph nam state = mapFindMaybe nam (graphs state)
-
-findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
-findFormula nam state = case findGraph nam state of
-        Nothing  -> getMaybeContextAxiom nam (mapVals $ rulesets state)
-        Just []  -> Just $ Formula nam emptyRDFGraph
-        Just grs -> Just $ Formula nam (head grs)
-
-modRules ::
-    ( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
-modRules rlmod state = state { rules = rlmod (rules state) }
-
-findRule :: ScopedName -> SwishState -> Maybe RDFRule
-findRule nam state =
-    let
-        localrule   = mapFindMaybe nam (rules state)
-        contextrule = getMaybeContextRule nam $ mapVals $ rulesets state
-    in
-        case localrule of
-            Nothing -> contextrule
-            justlr  -> justlr
-
-modRulesets ::
-    ( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
-modRulesets rsmod state = state { rulesets = rsmod (rulesets state) }
-
-findRuleset ::
-    ScopedName -> SwishState -> Maybe RDFRuleset
-findRuleset nam state = mapFindMaybe (snScope nam) (rulesets state)
-
-findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
-findOpenVarModify nam _ = findRDFOpenVarBindingModifier nam
-
-findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
-findDatatype nam _ = findRDFDatatype nam
-
-setInfo :: String -> SwishState -> SwishState
-setInfo msg state = state { infomsg = Just msg }
-
-resetInfo :: SwishState -> SwishState
-resetInfo state = state { infomsg = Nothing }
-
-setError :: String -> SwishState -> SwishState
-setError msg state = state { errormsg = Just msg }
-
-resetError :: SwishState -> SwishState
-resetError state = state { errormsg = Nothing }
-
-setExitcode :: ExitCode -> SwishState -> SwishState
-setExitcode ec state = state { exitcode = ec }
-
-
-------------------------------------------------------------
---  Data types for Swish script dictionaries
-------------------------------------------------------------
---
---  The graphs dictionary contains named graphs and/or lists
---  of graphs that are created and used by script statements.
-
-data NamedGraph = NamedGraph
-    { ngName    :: ScopedName
-    , ngGraph   :: [RDFGraph]
-    }
-
-instance LookupEntryClass NamedGraph ScopedName [RDFGraph]
-    where
-        keyVal   (NamedGraph k v) = (k,v)
-        newEntry (k,v)            = (NamedGraph k v)
-
-type NamedGraphMap = LookupMap NamedGraph
-
-------------------------------------------------------------
---  Report error and set exit status code
-------------------------------------------------------------
-
-swishError :: String -> Int -> SwishStateIO ()
-swishError msg sts =
-    do  { reportLine $ msg
-        ; if sts == 4 then
-            reportLine $ "Use 'Swish -?' for help"
-          else
-            return ()
-        ; modify $ setExitcode (ExitFailure sts)
-        }
-
-------------------------------------------------------------
---  Output text to the standard error stream
-------------------------------------------------------------
---
---  Each string in the supplied list is a line of text to
---  be displayed.
-
-reportLines  :: [String] -> SwishStateIO ()
-reportLines text =
-    sequence_ (map reportLine text)
-
-reportLine  :: String -> SwishStateIO ()
-reportLine line =
-    -- lift putStrLn line
-    lift $ hPutStrLn stderr line
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/SwishMonad.hs,v $
--- $Author: graham $
--- $Revision: 1.12 $
--- $Log: SwishMonad.hs,v $
--- Revision 1.12  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.11  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.10  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.9  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.8  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.7  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.6  2003/12/01 18:51:38  graham
--- Described syntax for Swish script.
--- Created Swish scripting test data.
--- Edited export/import lists in Swish main program modules.
---
--- Revision 1.5  2003/09/24 18:50:53  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.4  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.3  2003/05/29 12:39:49  graham
--- Improved error handling for stand-alone swish program
---
--- Revision 1.2  2003/05/21 13:34:13  graham
--- Various N3 parser bug fixes.
--- Need to fix handling of :name terms.
---
--- Revision 1.1  2003/05/20 23:36:30  graham
--- Add new Swish modules
---
− Swish/HaskellRDF/SwishScript.hs 
@@ -1,1031 +0,0 @@---------------------------------------------------------------------------------
---  $Id: SwishScript.hs,v 1.10 2004/02/09 22:22:44 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  SwishScript
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  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.
---
---  The script syntax is based loosely on Notation3, and the script parser is an
---  extension of the Notation3 parser in module N3Parser.hs.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.SwishScript
-    ( parseScriptFromString
-    )
-where
-
-import Swish.HaskellRDF.SwishMonad
-    ( SwishStateIO -    , modGraphs, findGraph, findFormula
-    , modRules, findRule
-    , modRulesets, findRuleset
-    , findOpenVarModify, findDatatype
-    , setInfo, setError, setExitcode
-    , NamedGraph(..)
-    )
-
-import Swish.HaskellRDF.RDFDatatype
-    ( RDFDatatype )
-
-import Swish.HaskellRDF.RDFRuleset
-    ( RDFFormula, RDFRule
-    , RDFRuleset
-    , makeRDFClosureRule
-    )
-
-import Swish.HaskellRDF.RDFProof
-    ( RDFProofStep, makeRDFProof, makeRDFProofStep )
-
-import Swish.HaskellRDF.RDFVarBinding
-    ( RDFVarBindingModify
-    )
-
-import Swish.HaskellRDF.RDFGraphShowM()
-
-import Swish.HaskellRDF.RDFGraph
-    ( RDFGraph, RDFLabel(..)
-    , emptyRDFGraph
-    , NamespaceMap
-    , setNamespaces
-    , merge, add
-    )
-
-import Swish.HaskellRDF.N3Parser
-    ( parseAnyfromString
-    , N3Parser, N3State(..)
-    , whiteSpace, symbol, eof, identLetter
-    , defaultPrefix, namedPrefix
-    , document, subgraph, uriRef2, varid, lexUriRef
-    , newBlankNode
-    )
-
-import Swish.HaskellRDF.N3Formatter
-    ( formatGraphAsShowS )
-
-import Swish.HaskellRDF.Datatype
-    ( typeMkRules )
-
-import Swish.HaskellRDF.Proof
-    ( explainProof, showsProof )
-
-import Swish.HaskellRDF.Ruleset
-    ( makeRuleset, getRulesetRule, getMaybeContextRule )
-
-import Swish.HaskellRDF.Rule
-    ( Formula(..), Rule(..) -- , RuleMap
-    )
-
-import Swish.HaskellRDF.VarBinding
-    ( composeSequence )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-import Swish.HaskellUtils.LookupMap
-    ( mapReplaceOrAdd )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv, flist )
-
-import Swish.HaskellUtils.ErrorM
-    ( ErrorM(..) )
-
-import Text.ParserCombinators.Parsec-    ( (<?>), (<|>)
-    , many, manyTill, option, sepBy, between, try, notFollowedBy
-    , string, char, anyChar
-    , getState
-    )
-
-import Control.Monad.State
-    ( modify, gets, lift
-    -- , StateT(..), execStateT
-    )
-
-import Control.Monad
-    ( when, liftM )
-
-{- WNH-import System.IO
-    ( IOMode(..), hPutStr
-    , IOError, try, ioeGetErrorString
-    )
-
-import qualified System.IO
-    ( IOMode(..), hPutStr
-    , IOError, try, ioeGetErrorString
-    )
-
-import Directory
-    ( doesFileExist )
--}-
--import qualified System.IO.Error as IO--import System.Exit
-    ( ExitCode(ExitFailure) )
-
-------------------------------------------------------------
---  Parser for Swish script processor
-------------------------------------------------------------
---
---  The parser is based on the Notation3 parser, and uses many
---  of the same syntax productions, but the top-level productions used
---  are quite different.
-
-parseScriptFromString :: Maybe String -> String -> ErrorM [SwishStateIO ()]
-parseScriptFromString base inp =
-    case parseAnyfromString script base inp of
-        Left  err -> Error  err
-        Right scs -> Result scs
-
-----------------------------------------------------------------------
---  Syntax productions
-----------------------------------------------------------------------
-
-script :: N3Parser [SwishStateIO ()]
-script =
-        do  { whiteSpace
-            ; scs <- many command
-            ; eof
-            ; return scs
-            }
-
-command :: N3Parser (SwishStateIO ())
-command =
-        do  { try $ symbol "@prefix"
-            ; ( defaultPrefix <|> namedPrefix )
-            ; return $ return ()
-            }
-    <|> nameItem
-    <|> readGraph
-    <|> writeGraph
-    <|> mergeGraphs
-    <|> compareGraphs
-    <|> assertEquiv
-    <|> assertMember
-    <|> defineRule
-    <|> defineRuleset
-    <|> defineConstraints
-    <|> checkProofCmd
-    <|> fwdChain
-    <|> bwdChain
-    <?>
-        "script command"
-
-nameItem :: N3Parser (SwishStateIO ())
-nameItem =
-        --  name :- graph
-        --  name :- ( graph* )
-        do  { u <- uriRef2
-            ; symbol ":-"
-            ; g <- graphOrList
-            ; return $ ssAddGraph u g
-            }
-
-readGraph :: N3Parser (SwishStateIO ())
-readGraph =
-        --  @read name  [ <uri> ]
-        do  { commandName "@read"
-            ; n <- uriRef2
-            ; u <- option "" lexUriRef
-            ; return $ ssRead n (if null u then Nothing else Just u)
-            }
-
-writeGraph :: N3Parser (SwishStateIO ())
-writeGraph =
-        --  @write name [ <uri> ] ; Comment
-        do  { commandName "@write"
-            ; n <- uriRef2
-            ; let gs = ssGetList n :: SwishStateIO (Either String [RDFGraph])
-            ; u <- option "" lexUriRef
-            ; symbol ";"
-            ; c <- restOfLine
-            ; let muri = if null u then Nothing else Just u
-            ; return $ ssWriteList muri gs c
-            }
-
-mergeGraphs :: N3Parser (SwishStateIO ())
-mergeGraphs =
-        --  @merge ( name* ) => name
-        do  { commandName "@merge"
-            ; gs <- graphList
-            ; symbol "=>"
-            ; n <- uriRef2
-            ; return $ ssMerge n gs
-            }
-
-compareGraphs :: N3Parser (SwishStateIO ())
-compareGraphs =
-        --  @compare  name name
-        do  { commandName "@compare"
-            ; n1 <- uriRef2
-            ; n2 <- uriRef2
-            ; return $ ssCompare n1 n2
-            }
-
-assertEquiv :: N3Parser (SwishStateIO ())
-assertEquiv =
-        --  @asserteq name name ; Comment
-        do  { commandName "@asserteq"
-            ; n1 <- uriRef2
-            ; n2 <- uriRef2
-            ; symbol ";"
-            ; c <- restOfLine
-            ; return $ ssAssertEq n1 n2 c
-            }
-
-assertMember :: N3Parser (SwishStateIO ())
-assertMember =
-        --  @assertin name name ; Comment
-        do  { commandName "@assertin"
-            ; n1 <- uriRef2
-            ; n2 <- uriRef2
-            ; symbol ";"
-            ; c <- restOfLine
-            ; return $ ssAssertIn n1 n2 c
-            }
-
-defineRule :: N3Parser (SwishStateIO ())
-defineRule =
-        --  @rule name :- ( name* ) => name [ | ( (name var*)* ) ]
-        do  { commandName "@rule"
-            ; rn <- uriRef2
-            ; symbol ":-"
-            ; ags <- graphOrList
-            ; symbol "=>"
-            ; cg  <- graphExpr
-            ; vms <- option [] varModifiers
-            ; return $ ssDefineRule rn ags cg vms
-            }
-
-defineRuleset :: N3Parser (SwishStateIO ())
-defineRuleset =
-        --  @ruleset name :- ( name* ) ; ( name* )
-        do  { commandName "@ruleset"
-            ; sn <- uriRef2
-            ; symbol ":-"
-            ; ags <- nameList
-            ; symbol ";"
-            ; rns <- nameList
-            ; return $ ssDefineRuleset sn ags rns
-            }
-
-defineConstraints :: N3Parser (SwishStateIO ())
-defineConstraints =
-        --  @constraints pref :- ( name* ) | ( name* )
-        do  { commandName "@constraints"
-            ; sn <- uriRef2
-            ; symbol ":-"
-            ; cgs <- graphOrList
-            ; symbol "|"
-            ; cns <- nameOrList
-            ; return $ ssDefineConstraints sn cgs cns
-            }
-
-checkProofCmd :: N3Parser (SwishStateIO ())
-checkProofCmd =
-        --  @proof name ( name* )
-        --    @input name
-        --    @step name ( name* ) => name  # rule-name, antecedents, consequent
-        --    @result name
-        do  { commandName "@proof"
-            ; pn  <- uriRef2
-            ; sns <- nameList
-            ; commandName "@input"
-            ; igf <- formulaExpr
-            ; sts <- many checkStep
-            ; commandName "@result"
-            ; rgf <- formulaExpr
-            ; return $ ssCheckProof pn sns igf sts rgf
-            }
-
-checkStep ::
-    N3Parser (Either String [RDFRuleset]
-                -> SwishStateIO (Either String RDFProofStep))
-checkStep =
-        do  { commandName "@step"
-            ; rn   <- uriRef2
-            ; agfs <- formulaList
-            ; symbol "=>"
-            ; cgf  <- formulaExpr
-            ; return $ ssCheckStep rn agfs cgf
-            }
-
-fwdChain :: N3Parser (SwishStateIO ())
-fwdChain =
-        --  #   ruleset rule (antecedents) => result
-        --  @fwdchain pref name ( name* ) => name
-        do  { commandName "@fwdchain"
-            ; sn  <- uriRef2
-            ; rn  <- uriRef2
-            ; ags <- graphOrList
-            ; symbol "=>"
-            ; cn  <- uriRef2
-            ; s <- getState             :: N3Parser N3State
-            ; let prefs = prefixUris s  :: NamespaceMap
-            ; return $ ssFwdChain sn rn ags cn prefs
-            }
-
-bwdChain :: N3Parser (SwishStateIO ())
-bwdChain =
-        --  #   ruleset rule consequent <= (antecedent-alts)
-        --  @bwdchain pref name graph <= name
-        do  { commandName "@bwdchain"
-            ; sn  <- uriRef2
-            ; rn  <- uriRef2
-            ; cg  <- graphExpr
-            ; symbol "<="
-            ; an  <- uriRef2
-            ; s <- getState             :: N3Parser N3State
-            ; let prefs = prefixUris s  :: NamespaceMap
-            ; return $ ssBwdChain sn rn cg an prefs
-            }
-
-----------------------------------------------------------------------
---  Syntax clause helpers
-----------------------------------------------------------------------
-
-commandName :: String -> N3Parser ()
-commandName cmd = try $
-        do  { string cmd
-            ; notFollowedBy identLetter
-            ; whiteSpace
-            }
-
-restOfLine :: N3Parser String
-restOfLine =
-        do  { s <- manyTill anyChar (char '\n')
-            ; whiteSpace
-            ; return s
-            }
-
-nameList :: N3Parser [ScopedName]
-nameList =
-        do  { symbol "("
-            ; ns <- many uriRef2
-            ; symbol ")"
-            ; return ns
-            }
-
-nameOrList :: N3Parser [ScopedName]
-nameOrList =
-        do  { n <- uriRef2
-            ; return $ [n]
-            }
-    <|>
-        nameList
-    <?>
-        "Name, or list of names"
-
-graphExpr :: N3Parser (SwishStateIO (Either String RDFGraph))
-graphExpr =
-        graphOnly
-    <|>
-        do  { f <- formulaExpr
-            ; return $ liftM (liftM formExpr) f
-            }
-    <?>
-        "Graph expression, graph name or named graph definition"
-
-graphOnly :: N3Parser (SwishStateIO (Either String RDFGraph))
-graphOnly =
-        do  { symbol "{"
-            ; b <- newBlankNode
-            ; g <- subgraph b       :: N3Parser RDFGraph
-            ; symbol "}"
-            ; s <- getState
-            ; let gp = setNamespaces (prefixUris s) g
-            ; return $ return (Right gp)
-            }
-
-graphList :: N3Parser [SwishStateIO (Either String RDFGraph)]
-graphList = between (symbol "(") (symbol ")") (many graphExpr)
-    <?>
-        "List of graphs"
-
-graphOrList :: N3Parser [SwishStateIO (Either String RDFGraph)]
-graphOrList =
-        do  { g <- graphExpr
-            ; return $ [g]
-            }
-    <|>
-        graphList
-    <?>
-        "Graph, or list of graphs"
-
-formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula))
-formulaExpr =
-        do  { n <- uriRef2
-            ; namedGraph n
-            }
-    <?> "Formula (name or named graph)"
-
-namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either String RDFFormula))
-namedGraph n =
-        do  { symbol ":-"
-            ; g <- graphOnly
-            ; return $ ssAddReturnFormula n g
-            }
-    <|>
-        return (ssGetFormula n)
-
-formulaList :: N3Parser [SwishStateIO (Either String RDFFormula)]
-formulaList = between (symbol "(") (symbol ")") (many formulaExpr)
-    <?>
-        "List of formulae (names or named graphs)"
-
-varModifiers :: N3Parser [(ScopedName,[RDFLabel])]
-varModifiers =
-        do  { symbol "|"
-            ; varModList
-            }
-
-varModList :: N3Parser [(ScopedName,[RDFLabel])]
-varModList =
-        do  { symbol "("
-            ; vms <- sepBy varMod (symbol ",")
-            ; symbol ")"
-            ; return vms
-            }
-    <|>
-        do  { vm <- varMod
-            ; return [vm]
-            }
-
-varMod :: N3Parser (ScopedName,[RDFLabel])
-varMod =
-        do  { rn  <- uriRef2
-            ; vns <- many varid
-            ; return (rn,vns)
-            }
-
-----------------------------------------------------------------------
---  SwishState helper functions
-----------------------------------------------------------------------
---
---  The functions below operate in the SwishStateIO monad, and are used
---  to assemble an executable version of the parsed script.
-
-ssAddReturnFormula ::
-    ScopedName -> SwishStateIO (Either String RDFGraph)
-    -> SwishStateIO (Either String RDFFormula)
-ssAddReturnFormula nam gf =
-        do  { egr <- gf
-            ; ssAddGraph nam [return egr]
-            ; return $ liftM (Formula nam) egr
-            }
-
-ssAddGraph ::
-    ScopedName -> [SwishStateIO (Either String RDFGraph)]
-    -> SwishStateIO ()
-ssAddGraph nam gf =
-    let errmsg = "Graph/list not added: "++show nam++"; "
-    in
-        do  { esg <- sequence gf        -- [Either String RDFGraph]
-            ; let egs = sequence esg    -- Either String [RDFGraph]
-            ; let fgs = case egs of
-                    Left  er -> setError  (errmsg++er)
-                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam gs))
-            ; modify fgs
-            }
-
-ssGetGraph :: ScopedName -> SwishStateIO (Either String RDFGraph)
-ssGetGraph nam =
-        do  { grs <- ssGetList nam
-            ; return $ liftM head grs
-            }
-
-ssGetFormula :: ScopedName -> SwishStateIO (Either String RDFFormula)
-ssGetFormula nam = gets find
-    where
-        find st = case findFormula nam st of
-            Nothing -> Left ("Formula not present: "++show nam)
-            Just gr -> Right $ gr
-
-ssGetList :: ScopedName -> SwishStateIO (Either String [RDFGraph])
-ssGetList nam = gets find
-    where
-        find st = case findGraph nam st of
-            Nothing  -> Left ("Graph or list not present: "++show nam)
-            Just grs -> Right $ grs
-
-ssRead :: ScopedName -> Maybe String -> SwishStateIO ()
-ssRead nam muri = ssAddGraph nam [ssReadGraph muri]
-
-ssReadGraph :: Maybe String -> SwishStateIO (Either String RDFGraph)
-ssReadGraph muri =
-        do  { inp <- getResourceData muri
-            ; return $ gf inp
-            }
-        where
-            gf inp = case inp of
-                Left  es -> Left es
-                Right is -> parseAnyfromString document muri is
-
-ssWriteList ::
-    Maybe String -> SwishStateIO (Either String [RDFGraph]) -> String
-    -> SwishStateIO ()
-ssWriteList muri gf comment =
-        do  { esgs <- gf
-            ; case esgs of
-                Left  er   -> modify $ setError ("Cannot write list: "++er)
-                Right [gr] -> ssWriteGraph muri gr comment
-                Right grs  -> sequence_ writegrs where
-                    writegrs = if null grs
-                        then [putResourceData Nothing ("+ Swish: Writing empty list"++)]
-                        else map writegr (zip [0..] grs)
-                    writegr (n,gr) = ssWriteGraph (murin muri n) gr
-                        ("["++show n++"] "++comment)
-                    murin Nothing    _ = Nothing
-                    murin (Just uri) n = Just (inituri++show n++lasturi)
-                        where
-                            splituri1 = splitBy (=='/') uri
-                            splituri2 = splitBy (=='.') (lastseg splituri1)
-                            inituri   = concat (initseg splituri1 ++ initseg splituri2)
-                            lasturi   = lastseg splituri2
-            }
-
-splitBy :: (a->Bool) -> [a] -> [[a]]
-splitBy _ []  = []
-splitBy p (s0:str) = let (s1,sr) = break p str in
-    (s0:s1):splitBy p sr
-
-lastseg :: [[a]] -> [a]
-lastseg []   = []
-lastseg [as] = []
-lastseg ass  = last ass
-
-initseg :: [[a]] -> [[a]]
-initseg []   = []
-initseg [as] = [as]
-initseg ass  = init ass
-
-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 String -> RDFGraph -> String -> SwishStateIO ()
-ssWriteGraph muri gr comment =
-    putResourceData muri ((c++) . (formatGraphAsShowS gr))
-    where
-        c = "# "++comment++"\n"
-
-ssMerge ::
-    ScopedName -> [SwishStateIO (Either String RDFGraph)]
-    -> SwishStateIO ()
-ssMerge nam gfs =
-    let errmsg = "Graph merge not defined: "++show nam++"; "
-    in
-        do  { esg <- sequence gfs       -- [Either String RDFGraph]
-            ; let egs = sequence esg    -- Either String [RDFGraph]
-            ; let fgs = case egs of
-                    Left  er -> setError  (errmsg++er)
-                    Right [] -> setError  (errmsg++"No graphs to merge")
-                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam [g]))
-                            where g = foldl1 merge gs
-            ; modify fgs
-            }
-
-ssCompare :: ScopedName -> ScopedName -> SwishStateIO ()
-ssCompare n1 n2 =
-        do  { g1 <- ssGetGraph n1
-            ; g2 <- ssGetGraph n2
-            ; when (g1 /= g2) (modify $ setExitcode (ExitFailure 1))
-            }
-
-ssAssertEq :: ScopedName -> ScopedName -> String -> SwishStateIO ()
-ssAssertEq n1 n2 comment =
-    let er1 = ":\n  Graph or list compare not performed:  invalid graph/list."
-    in
-        do  { g1 <- ssGetList n1
-            ; g2 <- ssGetList n2
-            ; case (g1,g2) of
-                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)
-                (_,Left er) -> modify $ setError (comment++er1++"\n  "++er)
-                (Right gr1,Right gr2) ->
-                    when (not $ equiv gr1 gr2) $ modify $
-                      setError (comment++":\n  Graph "++show n1
-                                ++" differs from "++show n2++".")
-            }
-
-ssAssertIn :: ScopedName -> ScopedName -> String -> SwishStateIO ()
-ssAssertIn n1 n2 comment =
-    let er1 = ":\n  Membership test not performed:  invalid graph."
-        er2 = ":\n  Membership test not performed:  invalid list."
-    in
-        do  { g1 <- ssGetGraph n1
-            ; g2 <- ssGetList  n2
-            ; case (g1,g2) of
-                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)
-                (_,Left er) -> modify $ setError (comment++er2++"\n  "++er)
-                (Right gr,Right gs) ->
-                    when (not $ elem gr gs) $ modify $
-                    setError (comment++":\n  Graph "++show n1
-                              ++" not a member of "++show 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 rn agfs cgf vmds =
-    let errmsg1 = "Rule definition error in antecedent graph(s): "
-        errmsg2 = "Rule definition error in consequent graph: "
-        errmsg3 = "Rule definition error in variable modifier(s): "
-        errmsg4 = "Incompatible variable binding modifier sequence"
-    in
-        do  { aesg <- sequence agfs     -- [Either String RDFGraph]
-            ; let ags = sequence aesg   :: Either String [RDFGraph]
-            ; cg <- cgf                 -- Either String RDFGraph
-            ; let vmfs = map ssFindVarModify vmds
-            ; evms <- sequence vmfs     -- [Either String RDFVarBindingModify]
-            ; let vms = sequence evms   :: Either String [RDFVarBindingModify]
-            ; let frl = case (ags,cg,vms) of
-                    (Left er,_,_) -> setError (errmsg1++er)
-                    (_,Left er,_) -> setError (errmsg2++er)
-                    (_,_,Left er) -> setError (errmsg3++er)
-                    (Right agrs,Right cgr,Right vbms) ->
-                        let
-                            newRule vm = makeRDFClosureRule rn agrs cgr vm
-                        in
-                        case composeSequence vbms of
-                            Just vm -> modRules (mapReplaceOrAdd (newRule vm))
-                            Nothing -> setError errmsg4
-            ; modify frl
-            }
-
-ssFindVarModify ::
-    (ScopedName,[RDFLabel]) -> SwishStateIO (Either String RDFVarBindingModify)
-ssFindVarModify (nam,lbs) = gets $ findVarMod nam lbs
-    where
-        findVarMod nam lbs st = case findOpenVarModify nam st of
-            Just ovbm -> Right (ovbm lbs)
-            Nothing   -> Left  ("Undefined modifier: "++show nam)
-
-ssDefineRuleset ::
-    ScopedName
-    -> [ScopedName]
-    -> [ScopedName]
-    -> SwishStateIO ()
-ssDefineRuleset sn ans rns =
-    let errmsg1 = "Error in ruleset axiom(s): "
-        errmsg2 = "Error in ruleset rule(s): "
-    in
-        do  { let agfs = sequence $ map ssGetFormula ans
-                                        :: SwishStateIO [(Either String RDFFormula)]
-            ; aesg <- agfs              -- [Either String RDFFormula]
-            ; let eags = sequence aesg  :: Either String [RDFFormula]
-            ; let erlf = sequence $ map ssFindRule rns
-                                        :: SwishStateIO [(Either String RDFRule)]
-            ; rles <- erlf              -- [Either String RDFRule]
-            ; let erls = sequence rles  :: (Either String [RDFRule])
-            ; let frs = case (eags,erls) of
-                    (Left er,_) -> setError (errmsg1++er)
-                    (_,Left er) -> setError (errmsg2++er)
-                    (Right ags,Right rls) ->
-                        modRulesets (mapReplaceOrAdd rs)
-                        where
-                            rs = makeRuleset (snScope sn) ags rls
-            ; modify frs
-            }
-
-ssFindRule :: ScopedName -> SwishStateIO (Either String RDFRule)
-ssFindRule nam = gets $ find
-    where
-        find st = case findRule nam st of
-            Nothing -> Left ("Rule not found: "++show nam)
-            Just rl -> Right rl
-
-ssDefineConstraints  ::
-    ScopedName
-    -> [SwishStateIO (Either String RDFGraph)]
-    -> [ScopedName]
-    -> SwishStateIO ()
-ssDefineConstraints  sn cgfs dtns =
-    let errmsg1 = "Error in constraint graph(s): "
-        errmsg2 = "Error in datatype(s): "
-    in
-        do  { cges <- sequence cgfs     -- [Either String RDFGraph]
-            ; let ecgs = sequence cges  :: Either String [RDFGraph]
-            ; let ecgr = case ecgs of
-                    Left er   -> Left er
-                    Right []  -> Right $ emptyRDFGraph
-                    Right grs -> Right $ foldl1 merge grs
-            ; edtf <- sequence $ map ssFindDatatype dtns
-                                        -- [Either String RDFDatatype]
-            ; let edts = sequence edtf   :: Either String [RDFDatatype]
-            ; let frs = case (ecgr,edts) of
-                    (Left er,_) -> setError (errmsg1++er)
-                    (_,Left er) -> setError (errmsg2++er)
-                    (Right cgr,Right dts) ->
-                        modRulesets (mapReplaceOrAdd rs)
-                        where
-                            rs  = makeRuleset (snScope sn) [] rls
-                            rls = concatMap (flip typeMkRules cgr) dts
-            ; modify frs
-            }
-
-ssFindDatatype :: ScopedName -> SwishStateIO (Either String RDFDatatype)
-ssFindDatatype nam = gets $ find
-    where
-        find st = case findDatatype nam st of
-            Nothing -> Left ("Datatype not found: "++show nam)
-            Just dt -> Right 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 pn sns igf stfs rgf =
-    let
-        infmsg1 = "Proof satisfied: "
-        errmsg1 = "Error in proof ruleset(s): "
-        errmsg2 = "Error in proof input: "
-        errmsg3 = "Error in proof step(s): "
-        errmsg4 = "Error in proof goal: "
-        errmsg5 = "Proof not satisfied: "
-        proofname = " (Proof "++show pn++")"
-    in
-        do  { let rs1 = map ssFindRuleset sns       :: [SwishStateIO (Either String RDFRuleset)]
-            ; rs2 <- sequence $ rs1                 -- [Either String RDFRuleset]
-            ; let erss = sequence rs2               :: Either String [RDFRuleset]
-            ; eig <- igf                            -- Either String RDFFormula
-            ; let st1  = sequence $ flist stfs erss :: SwishStateIO [Either String RDFProofStep]
-            ; st2 <- st1                            -- [Either String RDFProofStep]
-            ; let ests = sequence st2               :: Either String [RDFProofStep]
-            ; erg  <- rgf                           -- Either String RDFFormula
-            ; let proof = case (erss,eig,ests,erg) of
-                    (Left er,_,_,_) -> Left (errmsg1++er++proofname)
-                    (_,Left er,_,_) -> Left (errmsg2++er++proofname)
-                    (_,_,Left er,_) -> Left (errmsg3++er++proofname)
-                    (_,_,_,Left er) -> Left (errmsg4++er++proofname)
-                    (Right rss, Right ig, Right sts, Right rg) ->
-                        Right (makeRDFProof rss ig rg sts)
-            ; when False $ case proof of
-                    (Left  er) -> return ()
-                    (Right pr) -> putResourceData Nothing $
-                                    (("Proof "++show pn++"\n")++)
-                                    . showsProof "\n" pr
-            ; let checkproof = case proof of
-                    (Left  er) -> setError er
-                    (Right pr) ->
-                        case explainProof pr of
-                            Nothing -> setInfo (infmsg1++show pn)
-                            Just ex -> setError (errmsg5++show pn++", "++ex)
-                        {-
-                        if not $ checkProof pr then
-                            setError (errmsg5++show pn)
-                        else
-                            setInfo (infmsg1++show pn)
-                        -}
-            ; modify $ 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 _  _    _   (Left  er)  = return $ Left er
-ssCheckStep rn eagf ecgf (Right rss) =
-    let
-        errmsg1 = "Rule not in proof step ruleset(s): "
-        errmsg2 = "Error in proof step antecedent graph(s): "
-        errmsg3 = "Error in proof step consequent graph: "
-    in
-        do  { let mrul = getMaybeContextRule rn rss :: Maybe RDFRule
-            ; esag <- sequence $ eagf               -- [Either String RDFFormula]]
-            ; let eags = sequence $ esag            :: Either String [RDFFormula]
-            ; ecg  <- ecgf                          -- Either String RDFFormula
-            ; let est = case (mrul,eags,ecg) of
-                    (Nothing,_,_) -> Left (errmsg1++show rn)
-                    (_,Left er,_) -> Left (errmsg2++er)
-                    (_,_,Left er) -> Left (errmsg3++er)
-                    (Just rul,Right ags,Right cg) ->
-                        Right $ makeRDFProofStep rul ags cg
-            ; return 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 sn rn agfs cn prefs =
-    let
-        errmsg1 = "FwdChain rule error: "
-        errmsg2 = "FwdChain antecedent error: "
-    in
-        do  { erl  <- ssFindRulesetRule sn rn
-            ; aesg <- sequence agfs     -- [Either String RDFGraph]
-            ; let eags = sequence aesg   :: Either String [RDFGraph]
-            ; let fcr = case (erl,eags) of
-                    (Left er,_) -> setError (errmsg1++er)
-                    (_,Left er) -> setError (errmsg2++er)
-                    (Right rl,Right ags) ->
-                        modGraphs (mapReplaceOrAdd (NamedGraph cn [cg]))
-                        where
-                            cg = case fwdApply rl ags of
-                                []  -> emptyRDFGraph
-                                grs -> setNamespaces prefs $ foldl1 add grs
-            ; modify fcr
-            }
-
-ssFindRulesetRule ::
-    ScopedName -> ScopedName -> SwishStateIO (Either String RDFRule)
-ssFindRulesetRule sn rn = gets $ find
-    where
-        find st = case findRuleset sn st of
-            Nothing -> Left ("Ruleset not found: "++show sn)
-            Just rs -> find1 rs
-        find1 rs = case getRulesetRule rn rs of
-            Nothing -> Left ("Rule not in ruleset: "++show sn++": "++show rn)
-            Just rl -> Right rl
-
-ssFindRuleset ::
-    ScopedName -> SwishStateIO (Either String RDFRuleset)
-ssFindRuleset sn = gets $ find
-    where
-        find st = case findRuleset sn st of
-            Nothing -> Left ("Ruleset not found: "++show sn)
-            Just rs -> Right 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 sn rn cgf an prefs =
-    let
-        errmsg1 = "BwdChain rule error: "
-        errmsg2 = "BwdChain goal error: "
-    in
-        do  { erl <- ssFindRulesetRule sn rn
-            ; ecg <- cgf                -- Either String RDFGraph
-            ; let fcr = case (erl,ecg) of
-                    (Left er,_) -> setError (errmsg1++er)
-                    (_,Left er) -> setError (errmsg2++er)
-                    (Right rl,Right cg) ->
-                        modGraphs (mapReplaceOrAdd (NamedGraph an ags))
-                        where
-                            ags  = map mergegr (bwdApply rl cg)
-                            mergegr grs = case grs of
-                                [] -> emptyRDFGraph
-                                _  -> setNamespaces prefs $ foldl1 add grs
-            ; modify fcr
-            }
-
---  Temporary implementation:  just read local file WNH
     ---  (Add logic to separate filenames from URIs, and
---  attempt HTTP GET, or similar.)
-getResourceData :: Maybe String -> SwishStateIO (Either String String)
-getResourceData muri =
-    case muri of
-        Nothing  -> fromStdin
-        Just uri -> fromUri uri
-    where
-    fromStdin =
-        do  { dat <- lift getContents
-            ; return $ Right dat
-            }
-    fromUri uri =
-        do  { -- WNH  b <- lift $ doesFileExist uri
-              -- WNH; if not b then
-                -- WNH  return $ Left ("File not found: "++uri)
-                -- WNHelse
-                fromFile uri
-            }
-    fromFile uri =
-        do  { dat <- lift $ readFile uri
-            ; return $ Right dat
-            }
-
---  Temporary implementation:  just write local file
---  (Need to add logic to separate filenames from URIs, and
---  attempt HTTP PUT, or similar.)
-putResourceData :: Maybe String -> ShowS -> SwishStateIO ()
-putResourceData muri gsh =
-    do  { ios <- lift $ IO.try $
-            case muri of
-                Nothing  -> toStdout
-                Just uri -> toUri uri
-        ; case ios of
-            Left  ioe -> modify $ setError
-                            ("Error writing graph: "++
-                             IO.ioeGetErrorString ioe)
-            Right a   -> return a
-        }
-    where
-        toStdout  = putStrLn gstr
-        toUri uri = writeFile uri gstr
-        gstr = gsh ""
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/SwishScript.hs,v $
--- $Author: graham $
--- $Revision: 1.10 $
--- $Log: SwishScript.hs,v $
--- Revision 1.10  2004/02/09 22:22:44  graham
--- Graph matching updates:  change return value to give some indication
--- of the extent match achieved in the case of no match.
--- Added new module GraphPartition and test cases.
--- Add VehicleCapcity demonstration script.
---
--- Revision 1.9  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.8  2003/12/19 15:51:41  graham
--- Sync minor edits
---
--- Revision 1.7  2003/12/12 14:12:01  graham
--- Add comment about parser structure to SwishScript.hs
---
--- Revision 1.6  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.5  2003/12/10 14:43:00  graham
--- Backup.
---
--- Revision 1.4  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.3  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.2  2003/12/05 02:31:32  graham
--- Script parsing complete.
--- Some Swish script functions run successfully.
--- Command execution to be completed.
---
--- Revision 1.1  2003/12/04 02:53:28  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
− Swish/HaskellRDF/SwishTest.hs 
@@ -1,182 +0,0 @@---------------------------------------------------------------------------------
---  $Id: SwishTest.hs,v 1.10 2004/01/06 13:53:10 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  SwishTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  SwishTest:  Test cases for Swish program.
---
---------------------------------------------------------------------------------
-
---  WNH RIP OUT   module Swish.HaskellRDF.SwishTest where--import System.Exit
--import System.Time
-
-import Test.HUnit
-      ( Test(..), Assertable(..),
-        assertEqual, runTestTT, runTestText, putTextToHandle )
-
-import Swish.HaskellRDF.SwishMain
--
-------------------------------------------------------------
---  Interactive test cases
-------------------------------------------------------------
-
-testSwish :: String -> IO Bool
-testSwish cmdline =
-    do  { exitcode <- runSwish cmdline
-        -- ; putStr $ "Exit status: "++(show exitcode)
-        ; return $ exitcode == ExitSuccess
-        }
-
-swishTestCase :: String -> Test
-swishTestCase cmdline = TestCase ( assert $ testSwish cmdline )
-
-test1 = runSwish "-?"
-test2 = runSwish "-!not=validcommand"
-
-test3 = swishTestCase "-i=Data/N3TestGenReport.n3"
-test4 = swishTestCase "-i=Data/sbp-data.n3"
-test5 = swishTestCase "-i=Data/Simple.n3 "
-test6 = swishTestCase "-i=Data/Simple.n3 -o=Data/Simple.tmp"
-test7 = swishTestCase "-i=Data/Simple.n3 -c=Data/Simple.n3"
-test8 = swishTestCase "-i=Data/Simple.n3 -c=Data/Simple.tmp"
-test9 = swishTestCase "-i=Data/Simple.tmp -c=Data/Simple.tmp"
-
-test10a = swishTestCase "-i=Data/Simple3.n3"
-test10b = swishTestCase "-i=Data/Simple3.n3 -o"
-
-test10 = swishTestCase "-i=Data/Simple3.n3 -o=Data/Simple3.tmp"
-test11 = swishTestCase "-i=Data/Simple3.n3 -c=Data/Simple3.n3"
-test12 = swishTestCase "-i=Data/Simple3.n3 -c=Data/Simple3.tmp"
-test13 = swishTestCase "-i=Data/Simple3.tmp -c=Data/Simple3.tmp"
-
-test20a = swishTestCase "-i=Data/N3TestGenReport.n3"
-test20b = swishTestCase "-i=Data/N3TestGenReport.n3 -o"
-
-test20 = swishTestCase "-i=Data/N3TestGenReport.n3 -o=Data/N3TestGenReport.tmp"
-test21 = swishTestCase "-i=Data/N3TestGenReport.n3 -c=Data/N3TestGenReport.n3"
-test22 = swishTestCase "-i=Data/N3TestGenReport.n3 -c=Data/N3TestGenReport.tmp"
-test23 = swishTestCase "-i=Data/N3TestGenReport.tmp -c=Data/N3TestGenReport.tmp"
-
-test30 = swishTestCase "-i=Data/Merge1.n3 -m=Data/Merge2.n3 -c=Data/Merge3.n3"
-
-test31 = swishTestCase "-s=Swishtest.ss"
-
-tests1a = swishTestCase "-i=Data/Simple2.n3 -o=Data/Simple2.tmp"
-tests1b = swishTestCase "-i=Data/Simple2.n3 -c=Data/Simple2.tmp"
-
-allTests = TestList
-    [ test3
-    , test4
-    , test5
-    , test6
-    , test7
-    , test8
-    , test9
-    , test10
-    , test11
-    , test12
-    , test13
-    , tests1a
-    , tests1b
-    , test20
-    , test21
-    , test22
-    , test23
-    , test30
-    , test31
-    ]
-
-runTest t =
-    do  { st <- getClockTime
-        ; putStr $ "Test started:  "++show st++"\n"
-        ; runTestTT t
-        ; ft <- getClockTime
-        ; putStr $ "Test finished: "++show ft++"\n"
-        ; let et = diffClockTimes ft st
-        ; return et
-        ; putStr $ "Test duration: "++show et++"\n"
-        }
-
-testAll = runTest allTests
-
-tt   = runTest
-t20a = runTest test20a
-t20b = runTest test20b
-
-main = testAll
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/SwishTest.hs,v $
--- $Author: graham $
--- $Revision: 1.10 $
--- $Log: SwishTest.hs,v $
--- Revision 1.10  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.9  2003/09/24 18:50:53  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.8  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.7  2003/05/29 11:53:31  graham
--- Juggle Swish code:  SwishMain.hs is main program logic, with
--- Swish.hs and SwishTest.hs being alternative "Main" modules for
--- the real program and test harness respectively.
---
--- Revision 1.6  2003/05/29 10:49:08  graham
--- Added and tested merge option (-m) for Swish program
---
--- Revision 1.5  2003/05/29 01:50:56  graham
--- More performance tuning, courtesy of GHC profiler.
--- All modules showing reasonable performance now.
---
--- Revision 1.4  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.3  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.2  2003/05/28 17:39:30  graham
--- Trying to track down N3 formatter performance problem.
---
--- Revision 1.1  2003/05/23 00:03:55  graham
--- Added HUnit test module for swish program.
--- Greatly enhanced N3Formatter tests
---
− Swish/HaskellRDF/VarBinding.hs 
@@ -1,593 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}-{-# OPTIONS -XTypeSynonymInstances #-}---------------------------------------------------------------------------------
---  $Id: VarBinding.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  VarBinding
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines functions for representing and manipulating query
---  binding variable sets.  This is the key data that mediates between
---  query and back substitution when performing inferences.  A framework
---  of query variable modifiers is provided that can be used to
---  implement richer inferences, such as filtering of  query results,
---  or replacing values based on known relationships.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.VarBinding
-    ( VarBinding(..), nullVarBinding
-    , boundVars, subBinding, makeVarBinding
-    , applyVarBinding, joinVarBindings, addVarBinding
-    , VarBindingModify(..), OpenVarBindingModify
-    , vbmCompatibility, vbmCompose
-    , composeSequence, findCompositions, findComposition
-    , VarBindingFilter(..)
-    , makeVarFilterModify
-    , makeVarTestFilter, makeVarCompareFilter
-    , varBindingId, nullVarBindingModify
-    , varFilterDisjunction, varFilterConjunction
-    , varFilterEQ, varFilterNE
-    )
-where
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..) -    , makeLookupMap, mapFindMaybe
-    )
-
-import Swish.HaskellUtils.Namespace
-    ( ScopedName(..) )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv, subset, flist, headOrNothing, permutations )
-
-import Data.Maybe
-    ( catMaybes, fromMaybe, isJust, fromJust, listToMaybe )
-
-import Data.List
-    ( find, intersect, union, (\\) )
-
-
-------------------------------------------------------------
---  Query variable bindings
-------------------------------------------------------------
-
--- |VarBinding is the type of an arbitrary variable bindings
---  value, where the type of the bound values is not specified.
---
-data VarBinding a b = VarBinding
-    { vbMap  :: a -> Maybe b
-    , vbEnum :: [(a,b)]
-    , vbNull :: Bool
-    }
-
--- |VarBinding is an instance of class Eq, so that variable
---  bindings can be compared for equivalence
---
-instance (Eq a, Eq b) => Eq (VarBinding a b) where
-    vb1 == vb2 = (vbEnum vb1) `equiv` (vbEnum vb2)
-
--- |VarBinding is an instance of class Show, so that variable
---  bindings can be displayed
---
-instance (Show a, Show b) => Show (VarBinding a b) where
-    show vb = show (vbEnum vb)
-
--- |nullVarBinding:  maps no query variables.
---
-nullVarBinding :: VarBinding a b
-nullVarBinding = VarBinding
-    { vbMap  = const Nothing
-    , vbEnum = []
-    , vbNull = True
-    }
-
--- |Return a list of the variables bound by a supplied variable binding
---
-boundVars :: VarBinding a b -> [a]
-boundVars = map fst . vbEnum
-
--- |VarBinding subset function, tests to see if one query binding
---  is a subset of another;  i.e. every query variable mapping defined
---  by one is also defined by the other.
---
-subBinding :: (Eq a, Eq b) => (VarBinding a b) -> (VarBinding a b) -> Bool
-subBinding vb1 vb2 = (vbEnum vb1) `subset` (vbEnum vb2)
-
--- |Function to make a variable binding from a list of
---  pairs of variable and corresponding assigned value.
---
-makeVarBinding :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> VarBinding a b
-makeVarBinding vrbs =
-    if null vrbs then nullVarBinding -- (nullVarBinding :: VarBinding a b)
-    else VarBinding
-        { vbMap  = selectFrom vrbs
-        , vbEnum = vrbs
-        , vbNull = null vrbs
-        }
-    where
-        selectFrom = flip mapFindMaybe . makeLookupMap
-        --  selectFrom bs is the VarBinding lookup function
-        {-
-        selectFrom :: (Eq a) => [(a,b)] -> a -> Maybe b
-        selectFrom []         _ = Nothing
-        selectFrom ((v,r):bs) l = if l == v then Just r
-                                    else selectFrom bs l
-        -}
-
--- |Apply query binding to a supplied value, returning the value
---  unchanged if no binding is defined
---
-applyVarBinding :: VarBinding a a -> a -> a
-applyVarBinding vbind v = fromMaybe v (vbMap vbind v)
-
--- |Join a pair of query bindings, returning a new binding that
---  maps all variables recognized by either of the input bindings.
---  If the bindings should overlap, such overlap is not detected and
---  the value from the first binding provided is used arbitrarily.
---
-joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b
-joinVarBindings vb1 vb2
-    | vbNull vb1 = vb2
-    | vbNull vb2 = vb1
-    | otherwise  = VarBinding
-        { vbMap  = mv12
-        , vbEnum = map (\v -> (v,fromJust (mv12 v))) bv12
-        , vbNull = False
-        }
-    where
-        -- flist fs a = map ($ a) fs;  see also monad function 'ap'
-        mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
-        bv12 = boundVars vb1 `union` boundVars vb2
-
--- |Add a single new value to a variable binding and return the resulting
---  new variable binding.
---
-addVarBinding :: (Eq a, Show a, Eq b, Show b) => a -> b -> VarBinding a b
-    -> VarBinding a b
-addVarBinding lb val vbind = joinVarBindings vbind $ makeVarBinding [(lb,val)]
-
-------------------------------------------------------------
---  Datatypes for variable binding modifiers
-------------------------------------------------------------
-
--- |Define the type of a function to modify variable bindings in
---  forward chaining based on rule antecedent matches.  This
---  function is used to implement the "allocated to" logic described
---  in Appendix B of the RDF semantics document, in which a specific
---  blank node is associated with all matches of some specific value
---  by applications of the rule on a given graph.
---  Use 'id' if no modification of the variable bindings is required.
---
---  This datatype consists of the modifier function itself, which
---  operates on a list of variable bindings rather than a single
---  variable binding (because some modifications share context across
---  a set of bindings), and some additional descriptive information
---  that allows possible usage patterns to be analyzed.
---
---  Some usage patterns (see vbmUsage):
---  (a) filter:  all variables are input variables, and the effect
---      of the modifier function is to drop variable bindings that
---      don't satisfy some criterion.
---      Identifiable by an empty element in vbmUsage.
---  (b) source:  all variables are output variables:  a raw query
---      could be viewed as a source of variable bindings.
---      Identifiable by an element of vbmUsage equal to vbmVocab.
---  (c) modifier:  for each supplied variable binding, one or more
---      new variable bindings may be created that contain the
---      input variables bound as supplied plus some additional variables.
---      Identifiable by an element of vbmUsage some subset of vbmVocab.
---
---  A variety of variable usage patterns may be supported by a given
---  modifier:  a modifier may be used to define new variable bindings
---  from existing bindings in a number of ways, or simply to check that
---  some required relationship between bindings is satisfied.
---  (Example, for a + b = c, any one variable can be deduced from the
---  other two, or all three may be supplied to check that the relationship
---  does indeed hold.)
---
-data VarBindingModify a b = VarBindingModify
-    { vbmName   :: ScopedName
-                            -- ^Name used to identify this variable binding
-                            --  modifier when building inference rules.
-    , vbmApply  :: [VarBinding a b] -> [VarBinding a b]
-                            -- ^Apply variable binding modifier to a
-                            --  list of variable bindings, returning a
-                            --  new list.  The result list is not
-                            --  necessarily the same length as the
-                            --  supplied list.
-    , vbmVocab  :: [a]      -- ^List of variables used by this modifier.
-                            --  All results of applying this modifier contain
-                            --  bindings for these variables.
-    , vbmUsage  :: [[a]]    -- ^List of binding modifier usage patterns
-                            --  supported.  Each pattern is characterized as
-                            --  a list of variables for which new bindings
-                            --  may be created by some application of this
-                            --  modifier, assuming that bindings for all other
-                            --  variables in vbmVocab are supplied.
-    }
-
--- |Allow a VarBindingModify value to be accessed using a LookupMap.
---
-instance LookupEntryClass
-    (VarBindingModify a b) ScopedName (VarBindingModify a b)
-    where
-        keyVal   vbm     = (vbmName vbm,vbm)
-        newEntry (_,vbm) = vbm
-
--- |Type for variable binding modifier that has yet to be instantiated
---  with respect to the variables that it operates upon.
---
-type OpenVarBindingModify lb vn = [lb] -> VarBindingModify lb vn
-
--- |Extract variable binding name from OpenVarBindingModify value
---
---  (Because only the name is required, the application to an undefined
---  list of variable labels should never be evaluated, as long as the
---  name is not dependent on the variable names in any way.)
---
---  NOT QUITE... some of the functions that create OpenVarBindingModify
---  instances also pattern-match the number of labels provided, forcing
---  evaluation of the labels parameter, even though it's not used.
---
-openVbmName :: OpenVarBindingModify lb vn -> ScopedName
-openVbmName ovbm = vbmName (ovbm (error "Undefined labels in variable binding"))
-
--- |Allow an OpenVarBindingModify value to be accessed using a LookupMap.
---
-instance LookupEntryClass
-    (OpenVarBindingModify a b) ScopedName (OpenVarBindingModify a b)
-    where
-        keyVal   ovbm     = (openVbmName ovbm,ovbm)
-        newEntry (_,ovbm) = ovbm
-
--- |Allow an OpenVarBindingModify value to be accessed using a LookupMap.
---
-instance Show (OpenVarBindingModify a b)
-    where
-        show = show . openVbmName
-
--- |Variable binding modifier compatibility test.
---
---  Given a list of bound variables and a variable binding modifier, return
---  a list of new variables that may be bound, or Nothing.
---
---  Note:  if the usage pattern component is well-formed (i.e. all
---  elements different) then at most one element can be compatible with
---  a given input variable set.
---
-vbmCompatibility :: (Eq a) => VarBindingModify a b -> [a] -> Maybe [a]
-vbmCompatibility vbm vars = find compat (vbmUsage vbm)
-    where
-        compat ovars = vbmCompatibleVars vars (vbmVocab vbm) ovars
-
--- |Variable binding usage compatibility test.
---
---  bvars   are variables supplied with bindings
---  vocab   are variables returned with bindings by a modifier
---  ovars   are variables assigned new bindings by a modifier
---
---  Returns True if the supplied variable bindings can be compatibly
---  processed by a variable binding usage with supplied vocabulary and
---  usage pattern.
---
-vbmCompatibleVars :: (Eq a) => [a] -> [a] -> [a] -> Bool
-vbmCompatibleVars bvars vocab ovars =
-    null (ivars `intersect` ovars) &&       -- ivars and ovars don't overlap
-    null ((vocab \\ ovars) \\ ivars)        -- ovars and ivars cover vocab
-    where
-        ivars = bvars `intersect` vocab
-
--- |Compose variable binding modifiers.
---
---  Returns Just a new variable binding modifier that corresponds to
---  applying the first supplied modifier and then applying the second
---  one, or Nothing if the two modifiers cannot be compatibly composed.
---
---  NOTE:  this function does not, in general, commute.
---
---  NOTE:  if there are different ways to achieve the same usage, that
---  usage is currently repeated in the result returned.
---
-vbmCompose :: (Eq a) => VarBindingModify a b -> VarBindingModify a b
-    -> Maybe (VarBindingModify a b)
-vbmCompose
-    (VarBindingModify nam1 app1 voc1 use1)
-    (VarBindingModify nam2 app2 voc2 use2)
-    | not (null use12) = Just $ VarBindingModify
-        { vbmName  = swishName ("_"++(snLocal nam1)++"_"++(snLocal nam2)++"_")
-        , vbmApply = app2 . app1
-        , vbmVocab = voc1 `union` voc2
-        , vbmUsage = use12
-        }
-    | otherwise = Nothing
-    where
-        use12 = compatibleUsage voc1 use1 use2
-
--- |Determine compatible ways in which variable binding modifiers may
---  be combined.
---
---  voc1    is the total vocabulary of the first modifier to be applied
---  use1    is a list of usage patterns for the first modifier.
---  use2    is a list of usage patterns for the second modifier.
---
---  Returns a list of possible usage patterns for the composition of
---  the first modifier with the second modifier, or an empty list if
---  the modifiers are incompatible.
---
---  The total vocabulary of a modifier is the complete set of variables
---  that are used or bound by the modifier.  After the modifier has been
---  applied, bindings must exist for all of these variables.
---
---  A usage pattern of a modifier is a set of variables for which new
---  bindings may be generated by the modifier.
---
---  The only way in which two variable binding modifiers can be incompatible
---  with each other is when they both attempt to create a new binding for
---  the same variable.  (Note that this does not mean the composition will
---  be compatible with all inputs:  see vbmCompatibleVars above.)
---
---  NOTE:  if there are different ways to achieve the same usage, that
---  usage is currently repeated in the result returned.
---
-compatibleUsage :: (Eq a) => [a] -> [[a]] -> [[a]] -> [[a]]
-compatibleUsage voc1 use1 use2 =
-    [ u1++u2 | u2 <- use2, null (voc1 `intersect` u2), u1 <- use1 ]
-
--- |Find all compatible compositions of a list of variable binding
---  modifiers for a given set of supplied bound variables.
-findCompositions :: (Eq a) => [VarBindingModify a b] -> [a]
-    -> [VarBindingModify a b]
-findCompositions vbms vars =
-    catMaybes $ map (composeCheckSequence vars) (permutations vbms)
-
--- |Compose sequence of variable binding modifiers, and check
---  that the result can be used compatibly with a supplied list
---  of bound variables, returning Just (composed modifier), or Nothing
---
-composeCheckSequence :: (Eq a) => [a] -> [VarBindingModify a b]
-    -> Maybe (VarBindingModify a b)
-composeCheckSequence vars vbms = useWith vars $ composeSequence vbms
-    where
-        --  Check that a Maybe modifier is compatible for use with an
-        --  indicated set of bound variables, and return (Just modifier)
-        --  or Nothing.
-        useWith _    Nothing    = Nothing
-        useWith vars (Just vbm)
-            | isJust $ vbmCompatibility vbm vars = (Just vbm)
-            | otherwise                          = Nothing
-
--- |Compose sequence of variable binding modifiers.
---
-composeSequence :: (Eq a) => [VarBindingModify a b]
-    -> Maybe (VarBindingModify a b)
-composeSequence [] = Just varBindingId
-composeSequence (vbm:vbms) =
-    foldl composePair (Just vbm) vbms
-
--- |Compose a pair of variable binding modifiers, returning
---  Just (composed modifier), or Nothing
---
-composePair :: (Eq a) => Maybe (VarBindingModify a b) -> VarBindingModify a b
-    -> Maybe (VarBindingModify a b)
-composePair Nothing     _    = Nothing
-composePair (Just vbm1) vbm2 = vbmCompose vbm1 vbm2
-
--- |Return Just a compatible composition of variable binding modifiers
---  for a given set of supplied bound variables, or Nothing if there
---  is no compatible composition
---
-findComposition :: (Eq a) => [VarBindingModify a b] -> [a]
-    -> Maybe (VarBindingModify a b)
-findComposition = listToMaybe `c2` findCompositions
-    where
-        c2 = (.) . (.)  -- compose with function of two arguments
-
--- |Variable binding modifier that returns exactly those
---  variable bindings presented.
---
-varBindingId :: VarBindingModify a b
-varBindingId = VarBindingModify
-    { vbmName   = swishName "varBindingId"
-    , vbmApply  = id
-    , vbmVocab  = []
-    , vbmUsage  = [[]]
-    }
-
--- |Null variable binding modifier
---
---  This is like varBindingId except parameterized by some labels.
---  I think this is redundant, and should be eliminated.
---
-nullVarBindingModify :: OpenVarBindingModify a b
-nullVarBindingModify lbs = VarBindingModify
-    { vbmName   = swishName "nullVarBindingModify"
-    , vbmApply  = id
-    , vbmVocab  = lbs
-    , vbmUsage  = [[]]
-    }
-
-------------------------------------------------------------
---  Query binding filters
-------------------------------------------------------------
-
--- |VarBindingFilter is a function type that tests to see if
---  a query binding satisfies some criterion.
---
---  Queries often want to apply some kind of filter or condition
---  to the variable bindings that are processed.  In inference rules,
---  it sometimes seems desirable to stipulate additional conditions on
---  the things that are matched.
---
---  This function type is used to perform such tests.
---  A number of simple implementations are included below.
-data VarBindingFilter a b = VarBindingFilter
-    { vbfName   :: ScopedName
-    , vbfVocab  :: [a]
-    , vbfTest   :: (VarBinding a b) -> Bool
-    }
-
--- |Make a variable binding modifier from a variable binding filter value.
-makeVarFilterModify :: VarBindingFilter a b -> VarBindingModify a b
-makeVarFilterModify vbf = VarBindingModify
-    { vbmName   = vbfName vbf
-    , vbmApply  = filter (vbfTest vbf)
-    , vbmVocab  = vbfVocab vbf
-    , vbmUsage  = [[]]
-    }
-
--- |Make a variable test filter for a named variable using a
---  supplied value testing function.
-makeVarTestFilter ::
-    ScopedName -> (b -> Bool) -> a -> VarBindingFilter a b
-makeVarTestFilter nam vtest var = VarBindingFilter
-    { vbfName   = nam
-    , vbfVocab  = [var]
-    , vbfTest   = \vb -> case vbMap vb var of
-                    Just val  -> vtest val
-                    _         -> False
-    }
-
--- |Make a variable comparison filter for named variables using
---  a supplied value comparison function.
-makeVarCompareFilter ::
-    ScopedName -> (b -> b -> Bool) -> a -> a -> VarBindingFilter a b
-makeVarCompareFilter nam vcomp v1 v2 = VarBindingFilter
-    { vbfName   = nam
-    , vbfVocab  = [v1,v2]
-    , vbfTest   = \vb -> case (vbMap vb v1,vbMap vb v2) of
-                    (Just val1, Just val2) -> vcomp val1 val2
-                    _                      -> False
-    }
-
-------------------------------------------------------------
---  Declare some generally useful query binding filters
-------------------------------------------------------------
-
--- |This function generates a query binding filter that ensures that
---  two indicated query variables are mapped to the same value.
-varFilterEQ :: (Eq b) => a -> a -> VarBindingFilter a b
-varFilterEQ v1 v2 =
-    makeVarCompareFilter (swishName "varFilterEQ") (==) v1 v2
-
--- |This function generates a query binding filter that ensures that
---  two indicated query variables are mapped to different values.
-varFilterNE :: (Eq b) => a -> a -> VarBindingFilter a b
-varFilterNE v1 v2 =
-    makeVarCompareFilter (swishName "varFilterNE") (/=) v1 v2
-
--- |This function composes a number of query binding filters
---  into a composite filter that accepts any query binding that
---  satisfies at least one of the component values.
-varFilterDisjunction :: (Eq a) => [VarBindingFilter a b]
-    -> VarBindingFilter a b
-varFilterDisjunction vbfs = VarBindingFilter
-    { vbfName   = swishName "varFilterDisjunction"
-    , vbfVocab  = foldl1 union (map vbfVocab vbfs)
-    , vbfTest   = or . flist (map vbfTest vbfs)
-    }
-
--- |This function composes a number of query binding filters
---  into a composite filter that accepts any query binding that
---  satisfies all of the component values.
---
---  The same function could be achieved by composing the component
---  filter-based modifiers, but this function is more convenient
---  as it avoids the need to check for modifier compatibility.
---
-varFilterConjunction :: (Eq a) => [VarBindingFilter a b]
-    -> VarBindingFilter a b
-varFilterConjunction vbfs = VarBindingFilter
-    { vbfName   = swishName "varFilterConjunction"
-    , vbfVocab  = foldl1 union (map vbfVocab vbfs)
-    , vbfTest   = and . flist (map vbfTest vbfs)
-    }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/VarBinding.hs,v $
--- $Author: graham $
--- $Revision: 1.12 $
--- $Log: VarBinding.hs,v $
--- Revision 1.12  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.11  2003/12/10 03:48:58  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.10  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.9  2003/12/08 17:29:19  graham
--- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
---
--- Revision 1.8  2003/12/08 16:58:27  graham
--- Add name to variable binding modifiers and filters.
--- Add namespace for Swish-defined names.
---
--- Revision 1.7  2003/12/04 02:53:28  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.6  2003/10/24 21:05:08  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.5  2003/10/22 15:47:46  graham
--- Working on datatype inference support.
---
--- Revision 1.4  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.3  2003/10/15 16:40:52  graham
--- Reworked RDFQuery to use new query binding framework.
--- (Note: still uses VarBindingFilter rather than VarBindingModify.
--- The intent is to incorproate the VarBindingModify logic into RDFProof,
--- displaying the existing use of BindingFilter.)
---
--- Revision 1.2  2003/10/15 00:07:01  graham
--- Added variable binding filter structures, and some common filters
---
--- Revision 1.1  2003/10/14 20:30:58  graham
--- Add separate module for generic variable binding functions.
---
− Swish/HaskellRDF/VarBindingTest.hs 
@@ -1,991 +0,0 @@---------------------------------------------------------------------------------
---  $Id: VarBindingTest.hs,v 1.6 2004/01/06 13:53:10 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  VarBindingTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test cases for variable binding values and
---  variable binding modifier values.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUT module Swish.HaskellRDF.VarBindingTest where
-
-import Swish.HaskellRDF.VarBinding
-    ( VarBinding(..)
-    , subBinding, nullVarBinding, makeVarBinding
-    , boundVars, subBinding, makeVarBinding
-    , applyVarBinding, joinVarBindings
-    , VarBindingModify(..)
-    , vbmCompatibility, vbmCompose
-    , findCompositions, findComposition
-    , makeVarFilterModify
-    , makeVarTestFilter, makeVarCompareFilter
-    , varBindingId, varFilterDisjunction, varFilterConjunction
-    , varFilterEQ, varFilterNE
-    )
-
-import Swish.HaskellRDF.Vocabulary
-    ( swishName )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , Assertion
-    , assertBool, assertEqual, assertString, assertFailure
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Control.Monad ( unless )
-
-import Data.List
-    ( sort, union, intersect )
-
-import Data.Maybe
-    ( isJust, fromJust )
-
-
-------------------------------------------------------------
---  Test case helpers
-------------------------------------------------------------
-
-assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
-assertMember preface expected actual =
-  unless (expected `elem` actual ) (assertFailure msg)
-  where msg = (if null preface then "" else preface ++ "\n") ++
-             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
-
-test :: String -> Bool -> Test
-test lab bv =
-    TestCase ( assertBool ("test:"++lab) bv )
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
-testLe lab eq a1 a2 =
-    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
-
--- Test for Just x or Nothing
-
-testJust :: String -> Maybe a -> Test
-testJust lab av =
-    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
-
-testNothing :: String -> Maybe a -> Test
-testNothing lab av =
-    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
-
--- Compare lists and lists of lists and Maybe lists for set equivalence:
-
-data ListTest a = ListTest [a]
-
-instance (Eq a) => Eq (ListTest a) where
-    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
-
-instance (Show a) => Show (ListTest a) where
-    show (ListTest a) = show a
-
-data MaybeListTest a = MaybeListTest (Maybe [a])
-
-instance (Eq a) => Eq (MaybeListTest a) where
-    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
-    MaybeListTest Nothing   == MaybeListTest Nothing   = True
-    _                       == _                       = False
-
-instance (Show a) => Show (MaybeListTest a) where
-    show (MaybeListTest a) = show a
-
-testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
-
-testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
-testEqvEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest $ map ListTest a1
-        ma2 = ListTest $ map ListTest a2
-
-testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
-testHasEqv lab a1 a2 =
-    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest a1
-        ma2 = map ListTest a2
-
-testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
-testMaybeEqv lab a1 a2 =
-    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = (MaybeListTest a1)
-        ma2 = (MaybeListTest a2)
-
-------------------------------------------------------------
---  Define and variable bindings
-------------------------------------------------------------
-
-vb1 :: VarBinding Int String
-vb1    = makeVarBinding [(1,"a"),(2,"b"),(3,"c")]
-vb1str = "[(1,\"a\"),(2,\"b\"),(3,\"c\")]"
-
-vb2 :: VarBinding Int String
-vb2    = makeVarBinding [(3,"c"),(2,"b"),(1,"a")]
-vb2str = "[(3,\"c\"),(2,\"b\"),(1,\"a\")]"
-
-vb3 :: VarBinding Int String
-vb3    = makeVarBinding [(1,"a"),(2,"b"),(3,"c"),(4,"d"),(5,"e")]
-vb3str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"d\"),(5,\"e\")]"
-
-vb4 :: VarBinding Int String
-vb4 = nullVarBinding
-vb4str = "[]"
-
-testVarBinding01 = test   "testVarBinding01" $ (vb1==vb2)
-testVarBinding02 = test   "testVarBinding02" $ (vb1/=vb3)
-testVarBinding03 = test   "testVarBinding03" $ (vb1/=vb4)
-testVarBinding04 = testEq "testVarBinding04" vb1str  $ show vb1
-testVarBinding05 = testEq "testVarBinding05" vb2str  $ show vb2
-testVarBinding06 = testEq "testVarBinding06" vb4str  $ show vb4
-
-testVarBinding10 = testEq "testVarBinding10" [1,2,3] $ boundVars vb1
-testVarBinding11 = testEq "testVarBinding11" [3,2,1] $ boundVars vb2
-testVarBinding12 = testEq "testVarBinding12" []      $ boundVars vb4
-
-testVarBinding20 = test   "testVarBinding20" $ (subBinding vb1 vb2)
-testVarBinding21 = test   "testVarBinding21" $ (subBinding vb1 vb3)
-testVarBinding22 = test   "testVarBinding22" $ not (subBinding vb1 vb4)
-testVarBinding23 = test   "testVarBinding23" $ (subBinding vb2 vb1)
-testVarBinding24 = test   "testVarBinding24" $ not (subBinding vb3 vb1)
-testVarBinding25 = test   "testVarBinding25" $ (subBinding vb4 vb1)
-testVarBinding26 = test   "testVarBinding26" $ (subBinding vb4 vb4)
-
-vb5 :: VarBinding Int Int
-vb5 = makeVarBinding [(1,11),(2,22),(3,33)]
-
-testVarBinding30 = testEq "testVarBinding30"  0 $ applyVarBinding vb5 0
-testVarBinding31 = testEq "testVarBinding31" 11 $ applyVarBinding vb5 1
-testVarBinding32 = testEq "testVarBinding32" 22 $ applyVarBinding vb5 2
-testVarBinding33 = testEq "testVarBinding33" 33 $ applyVarBinding vb5 3
-testVarBinding34 = testEq "testVarBinding34"  4 $ applyVarBinding vb5 4
-testVarBinding35 = testEq "testVarBinding35" 11 $ applyVarBinding vb5 11
-
-vb6 :: VarBinding Int String
-vb6 = makeVarBinding [(3,"cc"),(4,"dd"),(5,"ee")]
-
-vb12 = joinVarBindings vb1 vb2
-vb13 = joinVarBindings vb1 vb3
-vb14 = joinVarBindings vb1 vb4
-vb16 = joinVarBindings vb1 vb6
-vb21 = joinVarBindings vb2 vb1
-vb44 = joinVarBindings vb4 vb4
-
-vb12str = vb1str
-vb13str = vb3str
-vb14str = vb1str
-vb16str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"dd\"),(5,\"ee\")]"
-vb21str = vb2str
-vb44str = vb4str
-
-testVarBinding40 = test   "testVarBinding40" $ not (vbNull vb12)
-testVarBinding41 = test   "testVarBinding41" $ not (vbNull vb13)
-testVarBinding42 = test   "testVarBinding42" $ not (vbNull vb14)
-testVarBinding43 = test   "testVarBinding43" $ not (vbNull vb16)
-testVarBinding44 = test   "testVarBinding44" $ not (vbNull vb21)
-testVarBinding45 = test   "testVarBinding45" $ (vbNull vb44)
-
-testVarBinding50 = test   "testVarBinding50" $ (subBinding vb12 vb13)
-testVarBinding51 = test   "testVarBinding51" $ (subBinding vb12 vb14)
-testVarBinding52 = test   "testVarBinding52" $ (subBinding vb12 vb16)
-testVarBinding53 = test   "testVarBinding53" $ (subBinding vb12 vb21)
-testVarBinding54 = test   "testVarBinding54" $ not (subBinding vb12 vb44)
-testVarBinding55 = test   "testVarBinding55" $ not (subBinding vb13 vb12)
-testVarBinding56 = test   "testVarBinding56" $ (subBinding vb14 vb12)
-testVarBinding57 = test   "testVarBinding57" $ (subBinding vb44 vb12)
-testVarBinding58 = test   "testVarBinding58" $ not (subBinding vb16 vb12)
-
-testVarBinding60 = testEq "testVarBinding60" vb12str $ show vb12
-testVarBinding61 = testEq "testVarBinding61" vb13str $ show vb13
-testVarBinding62 = testEq "testVarBinding62" vb14str $ show vb14
-testVarBinding63 = testEq "testVarBinding63" vb16str $ show vb16
-testVarBinding64 = testEq "testVarBinding64" vb21str $ show vb21
-testVarBinding65 = testEq "testVarBinding65" vb44str $ show vb44
-
-testVarBinding70 = testEq "testVarBinding70" (Just "a")  $ vbMap vb16 1
-testVarBinding71 = testEq "testVarBinding71" (Just "c")  $ vbMap vb16 3
-testVarBinding72 = testEq "testVarBinding72" (Just "ee") $ vbMap vb16 5
-testVarBinding73 = testEq "testVarBinding73" Nothing     $ vbMap vb16 7
-
-testVarBindingSuite = TestList
-    [ testVarBinding01, testVarBinding02, testVarBinding03, testVarBinding04
-    , testVarBinding05, testVarBinding06
-    , testVarBinding10, testVarBinding11, testVarBinding12
-    , testVarBinding20, testVarBinding21, testVarBinding22, testVarBinding23
-    , testVarBinding24, testVarBinding25, testVarBinding26
-    , testVarBinding30, testVarBinding31, testVarBinding32, testVarBinding33
-    , testVarBinding34, testVarBinding35
-    , testVarBinding40, testVarBinding41, testVarBinding42, testVarBinding43
-    , testVarBinding44, testVarBinding45
-    , testVarBinding50, testVarBinding51, testVarBinding52, testVarBinding53
-    , testVarBinding54, testVarBinding55, testVarBinding56, testVarBinding57
-    , testVarBinding58
-    , testVarBinding60, testVarBinding61, testVarBinding62, testVarBinding63
-    , testVarBinding64, testVarBinding65
-    , testVarBinding70, testVarBinding71, testVarBinding72, testVarBinding73
-    ]
-
-------------------------------------------------------------
---  Variable binding modifier tests
-------------------------------------------------------------
-
-vb1m :: VarBinding String Int
-vb1m    = makeVarBinding [("a",1)]
-
-vb2m :: VarBinding String Int
-vb2m    = makeVarBinding [("a",1),("b",2)]
-
-vb3m :: VarBinding String Int
-vb3m    = makeVarBinding [("a",1),("c",3)]
-
-vb4m :: VarBinding String Int
-vb4m    = makeVarBinding [("b",2),("c",3)]
-
-vb5m :: VarBinding String Int
-vb5m    = makeVarBinding [("a",1),("b",2),("c",3)]
-
-vb6m :: VarBinding String Int
-vb6m    = makeVarBinding [("a",1),("b",2),("c",4)]
-
-vb9m :: VarBinding String Int
-vb9m    = makeVarBinding [("i",9)]
-
--- Add new bindings per vb9m
-vbm1 :: VarBindingModify String Int
-vbm1 = VarBindingModify
-    { vbmName  = swishName "vbm1"
-    , vbmApply = map (\vb -> joinVarBindings vb vb9m)
-    , vbmVocab = boundVars vb9m
-    , vbmUsage = [boundVars vb9m]
-    }
-
-[vb1m1] = vbmApply vbm1 [vb1m]
-[vb2m1] = vbmApply vbm1 [vb2m]
-
-testVarModifyName01 = testEq "testVarModifyName01"
-                        (swishName "vbm1") $
-                        vbmName vbm1
-
-testVarModify01 = testEq "testVarModify01" (Just 1) $ vbMap vb1m1 "a"
-testVarModify02 = testEq "testVarModify02" Nothing  $ vbMap vb1m1 "b"
-testVarModify03 = testEq "testVarModify03" Nothing  $ vbMap vb2m1 "c"
-testVarModify04 = testEq "testVarModify04" (Just 9) $ vbMap vb1m1 "i"
-testVarModify05 = testEq "testVarModify05" (Just 1) $ vbMap vb2m1 "a"
-testVarModify06 = testEq "testVarModify06" (Just 2) $ vbMap vb2m1 "b"
-testVarModify07 = testEq "testVarModify07" Nothing  $ vbMap vb2m1 "c"
-testVarModify08 = testEq "testVarModify08" (Just 9) $ vbMap vb2m1 "i"
-
-testVarModify10 = testEq "testVarModify10" (Just ["i"]) $
-                    vbmCompatibility vbm1 ["a","b"]
-testVarModify11 = testEq "testVarModify11" Nothing $
-                    vbmCompatibility vbm1 ["a","b","i"]
-
--- Filter for bindings that define a
-vbm2 :: VarBindingModify String Int
-vbm2 = VarBindingModify
-    { vbmName  = swishName "vbm2"
-    , vbmApply = filter (\vb -> isJust $ vbMap vb "a")
-    , vbmVocab = ["a"]
-    , vbmUsage = [[]]
-    }
-
-vb12m2 = vbmApply vbm2 [vb1m,vb2m,vb9m]
-
-testVarModifyName02 = testEq "testVarModifyName02"
-                        (swishName "vbm2") $
-                        vbmName vbm2
-
-testVarModify20 = testEq "testVarModify20" 2 $ length vb12m2
-testVarModify21 = testEq "testVarModify21" vb1m $ vb12m2!!0
-testVarModify22 = testEq "testVarModify22" vb2m $ vb12m2!!1
-testVarModify23 = testEq "testVarModify23" (Just []) $
-                    vbmCompatibility vbm2 ["a","b"]
-testVarModify24 = testEq "testVarModify24" (Just []) $
-                    vbmCompatibility vbm2 ["a","b"]
-testVarModify25 = testEq "testVarModify25" (Just []) $
-                    vbmCompatibility vbm2 ["a","b","i"]
-testVarModify26 = testEq "testVarModify26" Nothing $
-                    vbmCompatibility vbm2 ["i"]
-
--- Filter or add bindings so that a+b=c
-vbm3 :: VarBindingModify String Int
-vbm3 = VarBindingModify
-    { vbmName  = swishName "vbm3"
-    , vbmApply = sumBinding "a" "b" "c"
-    , vbmVocab = ["a","b","c"]
-    , vbmUsage = [[],["a"],["b"],["c"]]
-    }
-
-sumBinding :: String -> String -> String -> [VarBinding String Int]
-    -> [VarBinding String Int]
-sumBinding va vb vc vbinds = concatMap abSumc vbinds
-    where
-        abSumc :: VarBinding String Int -> [VarBinding String Int]
-        abSumc vbind =
-            abSumc1 (vbMap vbind va) (vbMap vbind vb) (vbMap vbind vc) vbind
-        abSumc1 (Just a) (Just b) (Just c) vbind
-            | (a+b) == c = [vbind]
-            | otherwise  = []
-        abSumc1 (Just a) (Just b) Nothing vbind  =
-            [ joinVarBindings vbind  $ makeVarBinding [(vc,a+b)] ]
-        abSumc1 (Just a) Nothing (Just c) vbind  =
-            [ joinVarBindings vbind  $ makeVarBinding [(vb,c-a)] ]
-        abSumc1 Nothing (Just b) (Just c) vbind  =
-            [ joinVarBindings vbind  $ makeVarBinding [(va,c-b)] ]
-        abSumc1 _ _ _ _ = []
-
-vb16m3 = vbmApply vbm3 [vb1m,vb2m,vb3m,vb4m,vb5m,vb6m]
-
-testVarModifyName03 = testEq "testVarModifyName03"
-                        (swishName "vbm3") $
-                        vbmName vbm3
-
-testVarModify30 = testEq "testVarModify30" 4 $ length vb16m3
-testVarModify31 = testEq "testVarModify31" vb5m $ (vb16m3!!0)
-testVarModify32 = testEq "testVarModify32" vb5m $ (vb16m3!!1)
-testVarModify33 = testEq "testVarModify33" vb5m $ (vb16m3!!2)
-testVarModify34 = testEq "testVarModify34" vb5m $ (vb16m3!!3)
-testVarModify35 = testEq "testVarModify35" (Just ["c"]) $
-                    vbmCompatibility vbm3 ["a","b"]
-testVarModify36 = testEq "testVarModify36" (Just ["b"]) $
-                    vbmCompatibility vbm3 ["a","c"]
-testVarModify37 = testEq "testVarModify37" (Just ["a"]) $
-                    vbmCompatibility vbm3 ["b","c","i"]
-testVarModify38 = testEq "testVarModify38" (Just []) $
-                    vbmCompatibility vbm3 ["i","c","a","b"]
-testVarModify39 = testEq "testVarModify39" Nothing $
-                    vbmCompatibility vbm3 ["i","a"]
-testVarModify40 = testEq "testVarModify40" Nothing $
-                    vbmCompatibility vbm3 ["i","b"]
-testVarModify41 = testEq "testVarModify41" Nothing $
-                    vbmCompatibility vbm3 ["i","c"]
-testVarModify42 = testEq "testVarModify42" Nothing $
-                    vbmCompatibility vbm3 ["i","d"]
-
-testVarModifySuite = TestList
-    [ testVarModifyName01, testVarModifyName02, testVarModifyName03
-    , testVarModify01, testVarModify02, testVarModify03
-    , testVarModify04, testVarModify05, testVarModify06
-    , testVarModify07, testVarModify08
-    , testVarModify10, testVarModify11
-    , testVarModify20, testVarModify21, testVarModify22
-    , testVarModify23, testVarModify24, testVarModify25
-    , testVarModify26
-    , testVarModify30, testVarModify31, testVarModify32
-    , testVarModify33, testVarModify34, testVarModify35
-    , testVarModify36, testVarModify37, testVarModify38
-    , testVarModify39, testVarModify40, testVarModify41
-    , testVarModify42
-    ]
-
-------------------------------------------------------------
---  Variable binding modifier composition tests
-------------------------------------------------------------
-
---  Given (1) a+b=c and (2) a+c=d, then:
---    a=1 b=2   =>   c=3 d=4   by (1) then (2)
---    a=1 c=3   =>   b=2 d=4   by (1) then (2) or (2) then (1)
---    a=1 d=4   =>   b=2 c=3   by (2) then (1)
---    b=2 c=3   =>   a=1 d=4   by (1) then (2)
---    b=2 d=4   =>   insufficient data
---    c=3 d=4   =>   a=1 b=2   by (2) then (1)
-
-
--- Filter or add bindings so that a+b=c
-vbm4 :: VarBindingModify String Int
-vbm4 = VarBindingModify
-    { vbmName  = swishName "vbm4"
-    , vbmApply = sumBinding "a" "c" "d"
-    , vbmVocab = ["a","c","d"]
-    , vbmUsage = [[],["a"],["c"],["d"]]
-    }
-
-Just vbm34 = vbmCompose vbm3 vbm4
-vbm34vocab = [ "a", "b", "c", "d"]
-vbm34usage = [ ["a","d"], ["b","d"], ["c","d"]
-             , ["a"], ["b"], ["c"], ["d"], []
-             ]
-
-Just vbm43 = vbmCompose vbm4 vbm3
-vbm43vocab = [ "a", "b", "c", "d"]
-vbm43usage = [ ["a","b"], ["b","c"], ["b","d"]
-             , ["a"], ["b"], ["c"], ["d"], []
-             ]
-
-vbab :: VarBinding String Int
-vbab    = makeVarBinding [("a",1),("b",2)]
-
-vbac :: VarBinding String Int
-vbac    = makeVarBinding [("a",1),("c",3)]
-
-vbad :: VarBinding String Int
-vbad    = makeVarBinding [("a",1),("d",4)]
-
-vbbc :: VarBinding String Int
-vbbc    = makeVarBinding [("b",2),("c",3)]
-
-vbbd :: VarBinding String Int
-vbbd    = makeVarBinding [("b",2),("d",4)]
-
-vbcd :: VarBinding String Int
-vbcd    = makeVarBinding [("c",3),("d",4)]
-
-vbabcd :: VarBinding String Int
-vbabcd    = makeVarBinding [("a",1),("b",2),("c",3),("d",4)]
-
-
-testVarModifyName04 = testEq "testVarModifyName04"
-                        (swishName "vbm4") $
-                        vbmName vbm4
-
-testVarModifyName05 = testEq "testVarModifyName05"
-                        (swishName "_vbm4_vbm3_") $
-                        vbmName vbm43
-
-testVarModifyName06 = testEq "testVarModifyName06"
-                        (swishName "_vbm3_vbm4_") $
-                        vbmName vbm34
-
-testVarCompose01 = testEqv "testVarCompose01" vbm34vocab $
-                   vbmVocab vbm34
-testVarCompose02 = testEqvEqv "testVarCompose02" vbm34usage $
-                   vbmUsage vbm34
-testVarCompose03 = testMaybeEqv "testVarCompose03" (Just ["c","d"]) $
-                    vbmCompatibility vbm34 ["a","b"]
-testVarCompose04 = testMaybeEqv "testVarCompose04" (Just ["b","d"]) $
-                    vbmCompatibility vbm34 ["a","c"]
-testVarCompose05 = testMaybeEqv "testVarCompose05" Nothing $
-                    vbmCompatibility vbm34 ["a","d"]
-testVarCompose06 = testMaybeEqv "testVarCompose06" (Just ["a","d"]) $
-                    vbmCompatibility vbm34 ["b","c"]
-testVarCompose07 = testMaybeEqv "testVarCompose07" Nothing $
-                    vbmCompatibility vbm34 ["b","d"]
-testVarCompose08 = testMaybeEqv "testVarCompose08" Nothing $
-                    vbmCompatibility vbm34 ["c","d"]
-testVarCompose09 = testMaybeEqv "testVarCompose09" (Just ["a"]) $
-                    vbmCompatibility vbm34 ["b","c","d"]
-testVarCompose10 = testMaybeEqv "testVarCompose10" (Just ["b"]) $
-                    vbmCompatibility vbm34 ["a","c","d"]
-testVarCompose11 = testMaybeEqv "testVarCompose11" (Just ["c"]) $
-                    vbmCompatibility vbm34 ["a","b","d"]
-testVarCompose12 = testMaybeEqv "testVarCompose12" (Just ["d"]) $
-                    vbmCompatibility vbm34 ["a","b","c"]
-testVarCompose13 = testMaybeEqv "testVarCompose13" (Just []) $
-                    vbmCompatibility vbm34 ["a","b","c","d"]
-testVarCompose14 = testEqv "testVarCompose14" [vbabcd,vbabcd,vbabcd] $
-                    vbmApply vbm34 [vbab,vbac,vbbc]
-testVarCompose15 = testEqv "testVarCompose15" [] $
-                    vbmApply vbm34 [vbad,vbbd,vbcd]
-
-testVarCompose21 = testEqv "testVarCompose21" vbm43vocab $
-                   vbmVocab vbm43
-testVarCompose22 = testEqvEqv "testVarCompose22" vbm43usage $
-                   vbmUsage vbm43
-testVarCompose23 = testMaybeEqv "testVarCompose23" Nothing $
-                    vbmCompatibility vbm43 ["a","b"]
-testVarCompose24 = testMaybeEqv "testVarCompose24" (Just ["b","d"]) $
-                    vbmCompatibility vbm43 ["a","c"]
-testVarCompose25 = testMaybeEqv "testVarCompose25" (Just ["b","c"]) $
-                    vbmCompatibility vbm43 ["a","d"]
-testVarCompose26 = testMaybeEqv "testVarCompose26" Nothing $
-                    vbmCompatibility vbm43 ["b","c"]
-testVarCompose27 = testMaybeEqv "testVarCompose27" Nothing $
-                    vbmCompatibility vbm43 ["b","d"]
-testVarCompose28 = testMaybeEqv "testVarCompose28" (Just ["a","b"]) $
-                    vbmCompatibility vbm43 ["c","d"]
-testVarCompose29 = testMaybeEqv "testVarCompose29" (Just ["a"]) $
-                    vbmCompatibility vbm43 ["b","c","d"]
-testVarCompose30 = testMaybeEqv "testVarCompose30" (Just ["b"]) $
-                    vbmCompatibility vbm43 ["a","c","d"]
-testVarCompose31 = testMaybeEqv "testVarCompose31" (Just ["c"]) $
-                    vbmCompatibility vbm43 ["a","b","d"]
-testVarCompose32 = testMaybeEqv "testVarCompose32" (Just ["d"]) $
-                    vbmCompatibility vbm43 ["a","b","c"]
-testVarCompose33 = testMaybeEqv "testVarCompose33" (Just []) $
-                    vbmCompatibility vbm43 ["a","b","c","d"]
-testVarCompose34 = testEqv "testVarCompose34" [] $
-                    vbmApply vbm43 [vbab,vbbc,vbbd]
-testVarCompose35 = testEqv "testVarCompose35" [vbabcd,vbabcd,vbabcd] $
-                    vbmApply vbm43 [vbac,vbad,vbcd]
-
--- [[[need test for incompatible composition]]] --
---  Three ways to be incompatible:
---  (a) both modifers define same new output
---  (b) output from second modifier is input to first modifier
-
-vbm5 :: VarBindingModify String Int
-vbm5 = VarBindingModify
-    { vbmName  = swishName "vbm5"
-    , vbmApply = id                 -- incorrect: dummy for testing only
-    , vbmVocab = ["a","b","c"]
-    , vbmUsage = [["a"],["b"]]
-    }
-
-vbm6 :: VarBindingModify String Int
-vbm6 = VarBindingModify
-    { vbmName  = swishName "vbm6"
-    , vbmApply = id                 -- incorrect: dummy for testing only
-    , vbmVocab = ["a","b","c"]
-    , vbmUsage = [["a","b"],["b","c"],["a","c"]]
-    }
-
-vbm7 :: VarBindingModify String Int
-vbm7 = VarBindingModify
-    { vbmName  = swishName "vbm7"
-    , vbmApply = id                 -- incorrect: dummy for testing only
-    , vbmVocab = ["a","b","c"]
-    , vbmUsage = [["a"]]
-    }
-
-vbm8 :: VarBindingModify String Int
-vbm8 = VarBindingModify
-    { vbmName  = swishName "vbm8"
-    , vbmApply = id                 -- incorrect: dummy for testing only
-    , vbmVocab = ["b","c","d"]
-    , vbmUsage = [["b"],["c"],["b","c"]]
-    }
-
-vbm56 = vbmCompose vbm5 vbm6
-vbm65 = vbmCompose vbm6 vbm5
-vbm78 = vbmCompose vbm7 vbm8
-vbm87 = vbmCompose vbm8 vbm7
-vbm87usage = [["a","b"],["a","c"],["a","b","c"]]
-
-testVarCompose41 = test   "testVarCompose41" $ not (isJust vbm56)
-testVarCompose42 = test   "testVarCompose42" $ not (isJust vbm65)
-testVarCompose43 = test   "testVarCompose43" $ not (isJust vbm78)
-testVarCompose44 = test   "testVarCompose44" $     (isJust vbm87)
-testVarCompose45 = testEqvEqv "testVarCompose45" vbm87usage $
-                    vbmUsage (fromJust vbm87)
-
-jvbm1id    = vbmCompose vbm1 varBindingId
-jvbmid1    = vbmCompose varBindingId vbm1
-
-testVarCompose51 = test   "testVarCompose51" $ isJust jvbm1id
-testVarCompose52 = test   "testVarCompose52" $ isJust jvbmid1
-
-[vb1m1id] = vbmApply (fromJust jvbm1id) [vb1m]
-[vb2m1id] = vbmApply (fromJust jvbm1id) [vb2m]
-
-testVarModifyName07 = testEq "testVarModifyName07"
-                        (swishName "_vbm1_varBindingId_") $
-                        vbmName (fromJust jvbm1id)
-
-testVarModifyName08 = testEq "testVarModifyName08"
-                        (swishName "_varBindingId_vbm1_") $
-                        vbmName (fromJust jvbmid1)
-
-testVarCompose61 = testEq "testVarCompose61" (Just 1) $ vbMap vb1m1id "a"
-testVarCompose62 = testEq "testVarCompose62" Nothing  $ vbMap vb1m1id "b"
-testVarCompose63 = testEq "testVarCompose63" Nothing  $ vbMap vb2m1id "c"
-testVarCompose64 = testEq "testVarCompose64" (Just 9) $ vbMap vb1m1id "i"
-testVarCompose65 = testEq "testVarCompose65" (Just 1) $ vbMap vb2m1id "a"
-testVarCompose66 = testEq "testVarCompose66" (Just 2) $ vbMap vb2m1id "b"
-testVarCompose67 = testEq "testVarCompose67" Nothing  $ vbMap vb2m1id "c"
-testVarCompose68 = testEq "testVarCompose68" (Just 9) $ vbMap vb2m1id "i"
-
-[vb1mid1] = vbmApply (fromJust jvbmid1) [vb1m]
-[vb2mid1] = vbmApply (fromJust jvbmid1) [vb2m]
-
-testVarCompose71 = testEq "testVarCompose71" (Just 1) $ vbMap vb1mid1 "a"
-testVarCompose72 = testEq "testVarCompose72" Nothing  $ vbMap vb1mid1 "b"
-testVarCompose73 = testEq "testVarCompose73" Nothing  $ vbMap vb2mid1 "c"
-testVarCompose74 = testEq "testVarCompose74" (Just 9) $ vbMap vb1mid1 "i"
-testVarCompose75 = testEq "testVarCompose75" (Just 1) $ vbMap vb2mid1 "a"
-testVarCompose76 = testEq "testVarCompose76" (Just 2) $ vbMap vb2mid1 "b"
-testVarCompose77 = testEq "testVarCompose77" Nothing  $ vbMap vb2mid1 "c"
-testVarCompose78 = testEq "testVarCompose78" (Just 9) $ vbMap vb2mid1 "i"
-
-testVarComposeSuite = TestList
-    [ testVarModifyName04, testVarModifyName05, testVarModifyName06
-    , testVarModifyName07, testVarModifyName08
-    , testVarCompose01, testVarCompose02, testVarCompose03, testVarCompose04
-    , testVarCompose05, testVarCompose06, testVarCompose07, testVarCompose08
-    , testVarCompose09, testVarCompose10, testVarCompose11, testVarCompose12
-    , testVarCompose13, testVarCompose14, testVarCompose15
-    , testVarCompose21, testVarCompose22, testVarCompose23, testVarCompose24
-    , testVarCompose25, testVarCompose26, testVarCompose27, testVarCompose28
-    , testVarCompose29, testVarCompose30, testVarCompose31, testVarCompose32
-    , testVarCompose33, testVarCompose34, testVarCompose35
-    , testVarCompose41, testVarCompose42, testVarCompose43, testVarCompose44
-    , testVarCompose45
-    , testVarCompose51, testVarCompose52
-    , testVarCompose61, testVarCompose62, testVarCompose63, testVarCompose64
-    , testVarCompose65, testVarCompose66, testVarCompose67, testVarCompose68
-    , testVarCompose71, testVarCompose72, testVarCompose73, testVarCompose74
-    , testVarCompose75, testVarCompose76, testVarCompose77, testVarCompose78
-    ]
-
-------------------------------------------------------------
---  Modifier composition discovery tests
-------------------------------------------------------------
-
---  vbm3: a+b=c (1)
---  vbm4: a+c=d (2)
---  vbm9: c+d=e (3)
---
---  a,b -> c,d,e  by (1,2,3)
---  a,c -> b,d,e  by (1,2,3)
---         d,b,e  by (2,1,3)
---         d,e,b  by (2,3,1)
---  a,d -> c,b,e  by (2,1,3)
---         c,e,b  by (2,3,1)
---  a,e -> None
---  b,c -> a,d,e  by (1,2,3)
---  b,d -> None
---  b,e -> None
---  c,d -> a,b,e  by (2,1,3)
---      -> a,e,a  by (2,3,1)
---      -> e,a,b  by (3,2,1)
---  c,e -> d,a,b  by (3,2,1)
---  d,e -> c,a,b  by (3,2,1)
-
-vbm9 :: VarBindingModify String Int
-vbm9 = VarBindingModify
-    { vbmName  = swishName "vbm9"
-    , vbmApply = sumBinding "c" "d" "e"
-    , vbmVocab = ["c","d","e"]
-    , vbmUsage = [[],["c"],["d"],["e"]]
-    }
-
-compab = findCompositions [vbm3,vbm4,vbm9] ["a","b"]    -- 1
-compac = findCompositions [vbm3,vbm4,vbm9] ["a","c"]    -- 3
-compad = findCompositions [vbm3,vbm4,vbm9] ["a","d"]    -- 2
-compae = findCompositions [vbm3,vbm4,vbm9] ["a","e"]    -- 0
-compba = findCompositions [vbm3,vbm4,vbm9] ["b","a"]    -- 1
-compbc = findCompositions [vbm3,vbm4,vbm9] ["b","c"]    -- 1
-compbd = findCompositions [vbm3,vbm4,vbm9] ["b","d"]    -- 0
-compbe = findCompositions [vbm3,vbm4,vbm9] ["b","e"]    -- 0
-compca = findCompositions [vbm3,vbm4,vbm9] ["c","a"]    -- 3
-compcd = findCompositions [vbm3,vbm4,vbm9] ["c","d"]    -- 3
-compce = findCompositions [vbm3,vbm4,vbm9] ["c","e"]    -- 1
-compde = findCompositions [vbm3,vbm4,vbm9] ["d","e"]    -- 1
-
-testVarModifyName09 = testEq "testVarModifyName08"
-                        (swishName "__vbm4_vbm3__vbm9_") $
-                        vbmName (compad!!0)
-
-testVarModifyName10 = testEq "testVarModifyName08"
-                        (swishName "__vbm4_vbm9__vbm3_") $
-                        vbmName (compad!!1)
-
-testFindComp01 = testEq "testFindComp01" 1 $ (length compab)
-testFindComp02 = testEq "testFindComp02" 3 $ (length compac)
-testFindComp03 = testEq "testFindComp03" 2 $ (length compad)
-testFindComp04 = testEq "testFindComp04" 0 $ (length compae)
-testFindComp05 = testEq "testFindComp05" 1 $ (length compba)
-testFindComp06 = testEq "testFindComp06" 1 $ (length compbc)
-testFindComp07 = testEq "testFindComp07" 0 $ (length compbd)
-testFindComp08 = testEq "testFindComp08" 0 $ (length compbe)
-testFindComp09 = testEq "testFindComp09" 3 $ (length compca)
-testFindComp10 = testEq "testFindComp10" 3 $ (length compcd)
-testFindComp11 = testEq "testFindComp11" 1 $ (length compce)
-testFindComp12 = testEq "testFindComp12" 1 $ (length compde)
-
-compvocab = ["a","b","c","d","e"]
-
-testFindComp21 = testEqv "testFindComp21" compvocab $ vbmVocab (head compab)
-testFindComp22 = testEqv "testFindComp22" compvocab $ vbmVocab (head compac)
-testFindComp23 = testEqv "testFindComp23" compvocab $ vbmVocab (head compad)
-testFindComp24 = testEqv "testFindComp24" compvocab $ vbmVocab (head compba)
-testFindComp25 = testEqv "testFindComp25" compvocab $ vbmVocab (head compbc)
-testFindComp26 = testEqv "testFindComp26" compvocab $ vbmVocab (head compca)
-testFindComp27 = testEqv "testFindComp27" compvocab $ vbmVocab (head compcd)
-testFindComp28 = testEqv "testFindComp28" compvocab $ vbmVocab (head compce)
-testFindComp29 = testEqv "testFindComp29" compvocab $ vbmVocab (head compde)
-
-testFindComp31 = testHasEqv "testFindComp31" ["c","d","e"] $ vbmUsage (head compab)
-testFindComp32 = testHasEqv "testFindComp32" ["b","d","e"] $ vbmUsage (head compac)
-testFindComp33 = testHasEqv "testFindComp33" ["b","c","e"] $ vbmUsage (head compad)
-testFindComp34 = testHasEqv "testFindComp34" ["c","d","e"] $ vbmUsage (head compba)
-testFindComp35 = testHasEqv "testFindComp35" ["a","d","e"] $ vbmUsage (head compbc)
-testFindComp36 = testHasEqv "testFindComp36" ["b","d","e"] $ vbmUsage (head compca)
-testFindComp37 = testHasEqv "testFindComp37" ["a","b","e"] $ vbmUsage (head compcd)
-testFindComp38 = testHasEqv "testFindComp38" ["a","b","d"] $ vbmUsage (head compce)
-testFindComp39 = testHasEqv "testFindComp39" ["a","b","c"] $ vbmUsage (head compde)
-
-compBindings :: [VarBinding String Int]
-compBindings = map makeVarBinding
-    [ [ ("a",1), ("b",2) ]
-    , [ ("a",1), ("c",3) ]
-    , [ ("a",1), ("d",4) ]
-    , [ ("a",1), ("e",7) ]
-    , [ ("b",2), ("c",3) ]
-    , [ ("b",2), ("d",4) ]
-    , [ ("b",2), ("e",7) ]
-    , [ ("c",3), ("d",4) ]
-    , [ ("c",3), ("e",7) ]
-    , [ ("d",4), ("e",7) ]
-    ]
-
-compResult :: [VarBinding String Int]
-compResult = map makeVarBinding
-    [ [ ("a",1), ("b",2), ("c",3), ("d",4), ("e",7) ] ]
-
-compApply :: [VarBindingModify String Int] -> [VarBinding String Int]
-compApply vbms = (vbmApply (head vbms)) compBindings
-
-testFindComp41 = testEqv "testFindComp41" compResult $ (compApply compab)
-testFindComp42 = testEqv "testFindComp42" compResult $ (compApply compac)
-testFindComp43 = testEqv "testFindComp43" compResult $ (compApply compad)
-testFindComp44 = testEqv "testFindComp44" compResult $ (compApply compba)
-testFindComp45 = testEqv "testFindComp45" compResult $ (compApply compbc)
-testFindComp46 = testEqv "testFindComp46" compResult $ (compApply compca)
-testFindComp47 = testEqv "testFindComp47" compResult $ (compApply compcd)
-testFindComp48 = testEqv "testFindComp48" compResult $ (compApply compce)
-testFindComp49 = testEqv "testFindComp49" compResult $ (compApply compde)
-
-jcompab = findComposition [vbm3,vbm4,vbm9] ["a","b"]    -- 1
-jcompac = findComposition [vbm3,vbm4,vbm9] ["a","c"]    -- 3
-jcompad = findComposition [vbm3,vbm4,vbm9] ["a","d"]    -- 1
-jcompae = findComposition [vbm3,vbm4,vbm9] ["a","e"]    -- 0
-jcompba = findComposition [vbm3,vbm4,vbm9] ["b","a"]    -- 1
-jcompbc = findComposition [vbm3,vbm4,vbm9] ["b","c"]    -- 1
-jcompbd = findComposition [vbm3,vbm4,vbm9] ["b","d"]    -- 0
-jcompbe = findComposition [vbm3,vbm4,vbm9] ["b","e"]    -- 0
-jcompca = findComposition [vbm3,vbm4,vbm9] ["c","a"]    -- 3
-jcompcd = findComposition [vbm3,vbm4,vbm9] ["c","d"]    -- 3
-jcompce = findComposition [vbm3,vbm4,vbm9] ["c","e"]    -- 1
-jcompde = findComposition [vbm3,vbm4,vbm9] ["d","e"]    -- 1
-
-testFindComp51 = testJust    "testFindComp51" jcompab
-testFindComp52 = testJust    "testFindComp52" jcompac
-testFindComp53 = testJust    "testFindComp53" jcompad
-testFindComp54 = testNothing "testFindComp54" jcompae
-testFindComp55 = testJust    "testFindComp55" jcompba
-testFindComp56 = testJust    "testFindComp56" jcompbc
-testFindComp57 = testNothing "testFindComp57" jcompbd
-testFindComp58 = testNothing "testFindComp58" jcompbe
-testFindComp59 = testJust    "testFindComp59" jcompca
-testFindComp60 = testJust    "testFindComp60" jcompcd
-testFindComp61 = testJust    "testFindComp61" jcompce
-testFindComp62 = testJust    "testFindComp62" jcompde
-
-testFindCompSuite = TestList
-    [ testVarModifyName09, testVarModifyName10
-    , testFindComp01, testFindComp02, testFindComp03, testFindComp04
-    , testFindComp05, testFindComp06, testFindComp07, testFindComp08
-    , testFindComp09, testFindComp10, testFindComp11, testFindComp12
-    , testFindComp21, testFindComp22, testFindComp23, testFindComp24
-    , testFindComp25, testFindComp26, testFindComp27, testFindComp28
-    , testFindComp29
-    , testFindComp31, testFindComp32, testFindComp33, testFindComp34
-    , testFindComp35, testFindComp36, testFindComp37, testFindComp38
-    , testFindComp39
-    , testFindComp41, testFindComp42, testFindComp43, testFindComp44
-    , testFindComp45, testFindComp46, testFindComp47, testFindComp48
-    , testFindComp49
-    ]
-
-------------------------------------------------------------
---  Variable binding filters
-------------------------------------------------------------
-
-testFilterBindings :: [VarBinding String Int]
-testFilterBindings = map makeVarBinding
-    [ [ ("a",0), ("b",2), ("c",2) ]
-    , [ ("a",0), ("b",2), ("c",3) ]
-    , [ ("a",1), ("b",2), ("c",2) ]
-    , [ ("a",1), ("b",2), ("c",3) ]
-    , [ ("a",1), ("b",2), ("c",0) ]
-    , [ ("a",0), ("b",2), ("c",0) ]
-    , [ ("a",4), ("b",2), ("c",4) ]
-    , [ ("x",4), ("y",2), ("z",4) ]
-    ]
-
-filtertesta0 :: VarBindingModify String Int
-filtertesta0 = makeVarFilterModify $
-        makeVarTestFilter (swishName "filtertesta0") (==0) "a"
-vba0 :: [VarBinding String Int]
-vba0 = map makeVarBinding
-    [ [ ("a",0), ("b",2), ("c",2) ]
-    , [ ("a",0), ("b",2), ("c",3) ]
-    , [ ("a",0), ("b",2), ("c",0) ]
-    ]
-
-filtertestc0 :: VarBindingModify String Int
-filtertestc0 = makeVarFilterModify $
-        makeVarTestFilter (swishName "filtertestc0") (==0) "c"
-vbc0 :: [VarBinding String Int]
-vbc0 = map makeVarBinding
-    [ [ ("a",1), ("b",2), ("c",0) ]
-    , [ ("a",0), ("b",2), ("c",0) ]
-    ]
-
-filtercompabeq :: VarBindingModify String Int
-filtercompabeq = makeVarFilterModify $ varFilterEQ "a" "b"
-vbabeq :: [VarBinding String Int]
-vbabeq = map makeVarBinding
-    [ ]
-
-filtercompaceq :: VarBindingModify String Int
-filtercompaceq = makeVarFilterModify $ varFilterEQ "a" "c"
-vbaceq :: [VarBinding String Int]
-vbaceq = map makeVarBinding
-    [ [ ("a",0), ("b",2), ("c",0) ]
-    , [ ("a",4), ("b",2), ("c",4) ]
-    ]
-
-filtercompbceq :: VarBindingModify String Int
-filtercompbceq = makeVarFilterModify $ varFilterEQ "b" "c"
-vbbceq :: [VarBinding String Int]
-vbbceq = map makeVarBinding
-    [ [ ("a",0), ("b",2), ("c",2) ]
-    , [ ("a",1), ("b",2), ("c",2) ]
-    ]
-
-filtercompbcne :: VarBindingModify String Int
-filtercompbcne = makeVarFilterModify $ varFilterNE "b" "c"
-vbbcne :: [VarBinding String Int]
-vbbcne = map makeVarBinding
-    [ [ ("a",0), ("b",2), ("c",3) ]
-    , [ ("a",1), ("b",2), ("c",3) ]
-    , [ ("a",1), ("b",2), ("c",0) ]
-    , [ ("a",0), ("b",2), ("c",0) ]
-    , [ ("a",4), ("b",2), ("c",4) ]
-    ]
-
-filterdisjunct :: VarBindingModify String Int
-filterdisjunct = makeVarFilterModify $
-                 varFilterDisjunction
-                    [ makeVarTestFilter (swishName "isZero") (==0) "a"
-                    , varFilterEQ "a" "c"]
-vbdisj = vbaceq `union` vba0
-
-filterconjunct :: VarBindingModify String Int
-filterconjunct = makeVarFilterModify $
-                 varFilterConjunction
-                    [ makeVarTestFilter (swishName "isZero") (==0) "a"
-                    , varFilterEQ "a" "c"]
-vbconj = vbaceq `intersect` vba0
-
-testFilterName01 = testEq "testFilterName01" (swishName "filtertesta0") $
-                    vbmName filtertesta0
-testFilterName02 = testEq "testFilterName02" (swishName "filtertestc0") $
-                    vbmName filtertestc0
-testFilterName03 = testEq "testFilterName03" (swishName "varFilterEQ") $
-                    vbmName filtercompabeq
-testFilterName04 = testEq "testFilterName04" (swishName "varFilterNE") $
-                    vbmName filtercompbcne
-testFilterName05 = testEq "testFilterName05" (swishName "varFilterDisjunction") $
-                    vbmName filterdisjunct
-testFilterName06 = testEq "testFilterName06" (swishName "varFilterConjunction") $
-                    vbmName filterconjunct
-
-testFilter01 = testEqv "testFilter01" vba0   $ vbmApply filtertesta0   testFilterBindings
-testFilter02 = testEqv "testFilter02" vbc0   $ vbmApply filtertestc0   testFilterBindings
-testFilter03 = testEqv "testFilter03" vbabeq $ vbmApply filtercompabeq testFilterBindings
-testFilter04 = testEqv "testFilter04" vbaceq $ vbmApply filtercompaceq testFilterBindings
-testFilter05 = testEqv "testFilter05" vbbceq $ vbmApply filtercompbceq testFilterBindings
-testFilter06 = testEqv "testFilter06" vbbcne $ vbmApply filtercompbcne testFilterBindings
-testFilter07 = testEqv "testFilter07" vbdisj $ vbmApply filterdisjunct testFilterBindings
-testFilter08 = testEqv "testFilter08" vbconj $ vbmApply filterconjunct testFilterBindings
-
-testFilter10 = testEqv "testFilter10" testFilterBindings $
-                vbmApply varBindingId testFilterBindings
-
-testFilterSuite = TestList
-    [ testFilterName01, testFilterName02, testFilterName03
-    , testFilterName04, testFilterName05, testFilterName06
-    , testFilter01, testFilter02, testFilter03, testFilter04
-    , testFilter05, testFilter06, testFilter07, testFilter08
-    , testFilter10
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-    [ testVarBindingSuite
-    , testVarModifySuite
-    , testVarComposeSuite
-    , testFindCompSuite
-    , testFilterSuite
-    ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/VarBindingTest.hs,v $
--- $Author: graham $
--- $Revision: 1.6 $
--- $Log: VarBindingTest.hs,v $
--- Revision 1.6  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.5  2003/12/08 16:58:27  graham
--- Add name to variable binding modifiers and filters.
--- Add namespace for Swish-defined names.
---
--- Revision 1.4  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.3  2003/10/15 16:40:52  graham
--- Reworked RDFQuery to use new query binding framework.
--- (Note: still uses VarBindingFilter rather than VarBindingModify.
--- The intent is to incorproate the VarBindingModify logic into RDFProof,
--- displaying the existing use of BindingFilter.)
---
--- Revision 1.2  2003/10/15 00:07:01  graham
--- Added variable binding filter structures, and some common filters
---
--- Revision 1.1  2003/10/14 20:30:58  graham
--- Add separate module for generic variable binding functions.
---
− Swish/HaskellRDF/Vocabulary.hs 
@@ -1,314 +0,0 @@---------------------------------------------------------------------------------
---  $Id: Vocabulary.hs,v 1.7 2004/01/07 19:49:13 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Vocabulary
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines some commonly used vocabulary terms,
---  using the Namespace and ScopedName data types.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellRDF.Vocabulary
-    ( namespaceNull
-    , namespaceRDF
-    , namespaceRDFS
-    , namespaceRDFD
-    , namespaceRDFC
-    , namespaceRDFO
-    , namespaceOWL
-    , namespaceXSD
-    , namespaceXsdType
-    , namespaceMATH
-    , namespaceLOG
-    , namespaceDAML
-    , namespaceDefault
-    , namespaceSwish, swishName
-    , namespaceLang,  langName, langTag, isLang
-    , scopeRDF
-    , scopeRDFS
-    , scopeRDFD
-    , rdf_datatype, rdf_resource, rdf_about, rdf_ID
-    , rdf_type
-    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
-    , rdfs_member
-    , rdfd_GeneralRestriction
-    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
-    , owl_sameAs
-    , xsd_type, xsd_string, xsd_boolean
-    , xsd_decimal, xsd_integer
-    , xsd_nonneg_integer, xsd_nonpos_integer, xsd_pos_integer, xsd_neg_integer
-    , xsd_float, xsd_double
-    , operator_plus, operator_minus, operator_slash, operator_star
-    , default_base
-    )
-where
-
-import Swish.HaskellUtils.Namespace
-    ( Namespace(..), ScopedName(..) )
-
-import Swish.HaskellUtils.MiscHelpers
-    ( lower )
-
-------------------------------------------------------------
---  Define some common namespace values
-------------------------------------------------------------
-
-namespaceNull :: Namespace-namespaceNull
-    = Namespace "" ""
-
-namespaceRDF :: Namespace-namespaceRDF    =
-    Namespace   "rdf"   "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
-
-namespaceRDFS :: Namespace-namespaceRDFS   =
-    Namespace   "rdfs"  "http://www.w3.org/2000/01/rdf-schema#"
-
-namespaceRDFD :: Namespace-namespaceRDFD   =
-    Namespace   "rdfd"  "http://id.ninebynine.org/2003/rdfext/rdfd#"
-
-namespaceRDFC :: Namespace-namespaceRDFC   =
-    Namespace   "rdfc"  "http://id.ninebynine.org/2003/rdfext/rdfc#"
-
-namespaceRDFO :: Namespace-namespaceRDFO   =
-    Namespace   "rdfo"  "http://id.ninebynine.org/2003/rdfext/rdfo#"
-
-namespaceOWL :: Namespace-namespaceOWL    =
-    Namespace   "owl"   "http://www.w3.org/2002/07/owl#"
-
-namespaceXSD :: Namespace-namespaceXSD    =
-    Namespace   "xsd"   "http://www.w3.org/2001/XMLSchema#"
-
-namespaceXsdType :: String -> Namespace-namespaceXsdType dtname =
-    Namespace   ("xsd_"++dtname)
-                ("http://id.ninebynine.org/2003/XMLSchema/"++dtname++"#")
-
-namespaceMATH :: Namespace-namespaceMATH   =
-    Namespace   "math"  "http://www.w3.org/2000/10/swap/math#"
-
-namespaceLOG :: Namespace-namespaceLOG    =
-    Namespace   "log"   "http://www.w3.org/2000/10/swap/log.n3#"
-
-namespaceDAML :: Namespace-namespaceDAML   =
-    Namespace   "daml"  "http://www.daml.org/2000/10/daml-ont#"
-
-namespaceDefault :: Namespace-namespaceDefault
-    = Namespace "default" "http://id.ninebynine.org/default/"
-
-namespaceSwish :: Namespace-namespaceSwish
-    = Namespace "swish" "http://id.ninebynine.org/2003/Swish/"
-
-swishName :: String -> ScopedName
-swishName local = ScopedName namespaceSwish local
-
------------------------------------------------------------
---  Language tags
-------------------------------------------------------------
---
---  Note:  simple language tag URIs may be abbreviated as lang:tag,
---  but if the tag contains ahyphen, this would not be valid QName
---  form in Notation3, even though it is a valid QName component.
---  Fortunately, they do not currently need to appear in Notation3 as
---  distinct labels (but future developments m,ay change that).
-
-namespaceLang :: Namespace
-namespaceLang
-    = Namespace "lang" "http://id.ninebynine.org/2003/Swish/Lang/"
-    -- To be replaced by urn:ietf:params:lang?
-
-langName :: String -> ScopedName
-langName tag = ScopedName namespaceLang (lower tag)
-
-langTag :: ScopedName -> String
-langTag sname = snLocal sname
-
-isLang :: ScopedName -> Bool
-isLang sname = snScope sname == namespaceLang
-
-------------------------------------------------------------
---  Define namespaces for RDF rules, axioms, etc
-------------------------------------------------------------
-
-scopeRDF :: Namespace-scopeRDF        =
-    Namespace   "rs_rdf"   "http://id.ninebynine.org/2003/Ruleset/rdf#"
-
-scopeRDFS :: Namespace-scopeRDFS       =
-    Namespace   "rs_rdfs"  "http://id.ninebynine.org/2003/Ruleset/rdfs#"
-
-scopeRDFD :: Namespace-scopeRDFD       =
-    Namespace   "rs_rdfd"  "http://id.ninebynine.org/2003/Ruleset/rdfd#"
-
-------------------------------------------------------------
---  Define some common vocabulary terms
-------------------------------------------------------------
-
-rdf_datatype            :: ScopedName-rdf_datatype            = ScopedName namespaceRDF  "datatype"
--rdf_resource            :: ScopedName-rdf_resource            = ScopedName namespaceRDF  "resource"
--rdf_about               :: ScopedName-rdf_about               = ScopedName namespaceRDF  "about"
--rdf_ID                  :: ScopedName-rdf_ID                  = ScopedName namespaceRDF  "ID"
-
-rdf_type                :: ScopedName-rdf_type                = ScopedName namespaceRDF  "type"
--rdf_first               :: ScopedName-rdf_first               = ScopedName namespaceRDF  "first"
--rdf_rest                :: ScopedName-rdf_rest                = ScopedName namespaceRDF  "rest"
--rdf_nil                 :: ScopedName-rdf_nil                 = ScopedName namespaceRDF  "nil"
--rdf_XMLLiteral          :: ScopedName-rdf_XMLLiteral          = ScopedName namespaceRDF  "XMLLiteral"
-
-rdfs_member             :: ScopedName-rdfs_member             = ScopedName namespaceRDFS "member"
-
-rdfd_GeneralRestriction :: ScopedName-rdfd_GeneralRestriction = ScopedName namespaceRDFD "GeneralRestriction"
--rdfd_onProperties       :: ScopedName-rdfd_onProperties       = ScopedName namespaceRDFD "onProperties"
--rdfd_constraint         :: ScopedName-rdfd_constraint         = ScopedName namespaceRDFD "constraint"
--rdfd_maxCardinality     :: ScopedName-rdfd_maxCardinality     = ScopedName namespaceRDFD "maxCardinality"
-
-xsd_type                :: String -> ScopedName-xsd_type typnam         = ScopedName namespaceXSD  typnam
--xsd_string              :: ScopedName-xsd_string              = xsd_type "string"
--xsd_boolean             :: ScopedName-xsd_boolean             = xsd_type "boolean"
--xsd_decimal             :: ScopedName-xsd_decimal             = xsd_type "decimal"
--xsd_integer             :: ScopedName-xsd_integer             = xsd_type "integer"
--xsd_nonneg_integer      :: ScopedName-xsd_nonneg_integer      = xsd_type "nonNegativeInteger"
--xsd_nonpos_integer      :: ScopedName-xsd_nonpos_integer      = xsd_type "nonPositiveInteger"
--xsd_pos_integer         :: ScopedName-xsd_pos_integer         = xsd_type "positiveInteger"
--xsd_neg_integer         :: ScopedName-xsd_neg_integer         = xsd_type "negativeInteger"
--xsd_float               :: ScopedName-xsd_float               = xsd_type "float"
--xsd_double              :: ScopedName-xsd_double              = xsd_type "double"
-
-owl_sameAs              :: ScopedName-owl_sameAs              = ScopedName namespaceOWL  "sameAs"
-
-operator_plus           :: ScopedName-operator_plus           = ScopedName namespaceRDFO "plus"
--operator_minus          :: ScopedName-operator_minus          = ScopedName namespaceRDFO "minus"
--operator_slash          :: ScopedName-operator_slash          = ScopedName namespaceRDFO "slash"
--operator_star           :: ScopedName-operator_star           = ScopedName namespaceRDFO "star"
-
-default_base            :: ScopedName-default_base            = ScopedName namespaceDefault "base"
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellRDF/Vocabulary.hs,v $
--- $Author: graham $
--- $Revision: 1.7 $
--- $Log: Vocabulary.hs,v $
--- Revision 1.7  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.6  2004/01/06 16:29:56  graham
--- Fix up module exports to avoid GHC warnings
---
--- Revision 1.5  2003/12/16 07:05:37  graham
--- Working on updated RDFProofContext
---
--- Revision 1.4  2003/12/11 19:11:07  graham
--- Script processor passes all initial tests.
---
--- Revision 1.3  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.2  2003/12/08 16:58:27  graham
--- Add name to variable binding modifiers and filters.
--- Add namespace for Swish-defined names.
---
--- Revision 1.1  2003/11/24 17:20:35  graham
--- Separate module Vocabulary from module Namespace.
---
− Swish/HaskellUtils/AccumulateM.hs 
@@ -1,143 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}-{-# OPTIONS -XFunctionalDependencies #-}-{-# OPTIONS -XFlexibleInstances #-}----------------------------------------------------------------------------------
---  $Id: AccumulateM.hs,v 1.3 2004/01/22 19:53:46 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  AccummulateM
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a monadic accumulator type.  The plan is that it be
---  used in conjunction with FunctorM and similar constructs to accumulate
---  some or all of the values visited.
---
---  Using a monad of type Accumulator, which wraps some type 'c' and is
---  also declared to be an instance of MonadAccum Accumulator c e, for some e,
---  then foldM can be used to accumulate values of type e with an initial
---  value of type c with the instance-supplied growVal method.
---
---  This module also declares accumulator instances for Int, Integer and list
---  datatypes.
---
---  This is all very well, but rather unnecessary:  it is just as easy, and
---  more standard (hence easier for other Haskell programmers to follow),
---  to use a state monad with a nullary return type; e.g.
---     execsState (stateMonadExpr) initialState
---  which returns the final state value.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.AccumulateM
-    ( Accumulator(..) )
-where
-
-import Control.Monad
-    ( foldM )
-
--class (Monad m) => MonadAccum m c e | m c -> e where
-    growVal :: c -> e -> m c
-    reapVal :: m c -> c
-
-data Accumulator c = Accumulator c deriving (Eq, Show)
-
-instance Monad Accumulator where
-    (Accumulator v) >>= k  = k v
-    return v               = Accumulator v
-
-instance MonadAccum Accumulator Int Int where
-    growVal n m             = Accumulator (n+m)
-    reapVal (Accumulator n) = n
-
-instance MonadAccum Accumulator Integer Integer where
-    growVal n m             = Accumulator (n+m)
-    reapVal (Accumulator n) = n
-
-instance MonadAccum Accumulator [v] v where
-    growVal vs v             = Accumulator (v:vs)
-    reapVal (Accumulator vs) = vs
-
-
---  Tests
-addVal :: Int -> Int -> (Accumulator Int)
-addVal m n = Accumulator (n+m)
-
-testList  = [1,2,3,4,5,6] :: [Int]
-testList1 = [1,2,3,4,5,6] :: [Integer]
-testList2 = "plugh"
-
-test1 = foldM addVal 0 testList
-test2 = Accumulator 0
-test3 = (Accumulator 0) >>= addVal 1
-test4 = (Accumulator 5) >>= addVal 5
-test5 = (growVal 3 :: Int -> Accumulator Int) 20
-test6 = foldM growVal 0 testList  :: Accumulator Int
-test7 = foldM growVal 0 testList1 :: Accumulator Integer
-test8 = reapVal (foldM growVal 0  testList  :: Accumulator Int)
-test9 = reapVal (foldM growVal [] testList2 :: Accumulator [Char])
-
-test = and
-    [ test1 == Accumulator 21
-    , test2 == Accumulator 0
-    , test3 == Accumulator 1
-    , test4 == Accumulator 10
-    , test5 == Accumulator 23
-    , test6 == Accumulator 21
-    , test7 == Accumulator 21
-    , test8 == 21
-    , test9 == "hgulp"
-    ]
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/AccumulateM.hs,v $
--- $Author: graham $
--- $Revision: 1.3 $
--- $Log: AccumulateM.hs,v $
--- Revision 1.3  2004/01/22 19:53:46  graham
--- Sync.
---
--- Revision 1.2  2004/01/13 17:12:08  graham
--- Complete functionality of AccumulateM, using functional dependencies
--- in the MonadAccum type class.
---
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.2  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.1  2003/06/12 00:49:04  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
− Swish/HaskellUtils/DateTime.hs 
@@ -1,391 +0,0 @@---------------------------------------------------------------------------------
---  $Id: DateTime.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  DateTime
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module defines a collection of date/time manipulation functions.
---
---  Date/time value manipulation.
---
---  Date/time can be date-only or time-only
---
---  type DateTime is an instance of built-in classes Eq and Show
---  type DateTime has a constructor that accepts a string in the format
---      defined by RFC 3339.
---      Timezone interpretation is per RFC3339.
---
---------------------------------------------------------------------------------
---
---            year,month,day,hour,min,sec,millisec,timezone
---class (Show a,Eq a) => DateTimeClass a where
---  newDateTime  :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> a
---  toString     :: a -> String
---  size         :: a -> Int
---  toDateTime   :: String -> a
---  toDate       :: String -> a
---  toTime       :: String -> a
---  (==)         :: a -> a -> Bool   -- same date/time
---  (<)        :: a -> a -> Bool   -- first precedes second
---  (+)        :: a -> a -> a  -- advance by time
---  (-)        :: a -> a -> a  -- difference between times
---  dtShow     :: a -> String             -- return string form
---  dtYear       :: a -> Int
---  dtMonth      :: a -> Int
---  dtDay        :: a -> Int
---  dtHour       :: a -> Int
---  dtMinute     :: a -> Int
---  dtSecond     :: a -> Int
---  dtMillisecs  :: a -> Int
---  dtTimezone   :: a -> Int                -- time zone offset in minutes
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.DateTime where
-
-data DateTime
-  = DateTime Int Int Int Int Int Int Int Int
-
-instance Eq DateTime where
-  d1 == d2 = simpleEq ( normTZ d1 ) ( normTZ d2 )
-
-instance Show DateTime where
-  show dt = dtShow dt
-
-instance Ord DateTime where
-  dt1 <  dt2  = simpleLT ( normTZ dt1 ) ( normTZ dt2 )
-  dt1 >  dt2  = dt2 < dt1
-  dt1 <= dt2  = (dt1 < dt2)||(dt1==dt2)
-  dt1 >= dt2  = (dt2 < dt1)||(dt1==dt2)
-
-leapYear :: Int -> Bool
-leapYear year
-  | ( year `mod` 4 == 0 ) &&
-    not ( ( year `mod` 100 == 0 ) &&
-          not ( year `mod` 400 == 0 ) ) = True
-  | otherwise                           = False
-
-daysInMonth :: Int -> Int -> Int
-daysInMonth month year
-  | month==1   = 31  --Jan
-  | month==2   = if leapYear year then 29 else 28 --Feb
-  | month==3   = 31  --Mar
-  | month==4   = 30  --Apr
-  | month==5   = 31  --May
-  | month==6   = 30  --Jun
-  | month==7   = 31  --Jul
-  | month==8   = 31  --Aug
-  | month==9   = 30  --Sep
-  | month==10  = 31  --Oct
-  | month==11  = 30  --Nov
-  | month==12  = 31  --Dec
-  | otherwise  = 0
-
-validJulianDate :: Int -> Int -> Int -> Bool
-validJulianDate yr mo da
-  | yr < 1900                = False
-  | mo > 12                  = False
-  | da > (daysInMonth mo yr) = False
-  | otherwise                = True
-
-toJulianDate1 :: DateTime -> Int
-toJulianDate1 (DateTime y m d _ _ _ _ _) = toJulianDate y m d
-
-toJulianDate :: Int -> Int -> Int -> Int
-toJulianDate year month day
---  | not (validJulianDate year month day) = -1
-  | year==1900 && month<=2               = if month==2 then day + 30 else day - 1
-  | month>=3                             = toJD1 (year-1900) (month-3) (day)
-  | otherwise                            = toJD1 (year-1901) (month+9) (day)
-  where
-    toJD1 :: Int -> Int -> Int -> Int
-    toJD1 year month day
-      = ( (1461*year) `div` 4 ) -
-        (year `div` 100) +
-        ((year+300) `div` 400) +
-        ( ( (153*month) + 2 ) `div` 5 ) +
-        day + 58
-
-fromJulianDate:: Int -> DateTime
-fromJulianDate jdate
-  | jdate <= 58 = fromJD1 jdate
-  | otherwise   = fromJD2 jdate
-  where
-    fromJD1 :: Int -> DateTime
-    fromJD1 jdate
-      | jdate<=30 = (DateTime 1900 1 (jdate+1 ) 0 0 0 0 0)
-      | otherwise = (DateTime 1900 2 (jdate-30) 0 0 0 0 0)
-
-    fromJD2 :: Int -> DateTime
-    fromJD2 j
-      = DateTime y2 m2 d1 0 0 0 0 0
-      where
---          t1 = (400*(j+((j+36467)`div`36525)-((j+109517)`div`dc))) - 23638 -- 1/400-days from 1900-02-28 [t]
-          t1 = (400*
-                    (j
-               +((4*(j+36465))`div`146097)
-                  -((j+109513)`div`146097))) - 23638 -- 1/400-days from 1900-02-28 [t]
-          dc = 146100                                -- days in cycle period (400 years) = 1/400-days in year
-          t2 = ( ( t1 `mod` dc ) `div` 400 )*5 + 2   -- fifth-days into year, +2                      [j3]
-          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)               [d]
-          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11                         [j4]
-          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12              [m]
-          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28
-          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around
-          -- 36525  = days/century, not counting century adjustments
-          -- 109517 = 146100 * (1900-1600)/400 - 58
-          -- 23238  = 58*400 + 38  ???   38=152/4 ??
-
-{-          -- this code works for dates before 2100 only
-          t1 = (4*j) - 233                           -- quarter-days from 1900-02-28
-          dc = 1461                                  -- days in cycle period (4 years) = quarter-days in year
-          t2 = ( ( t1 `mod` dc ) `div` 4 )*5 + 2     -- fifth-days into year, +2
-          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)
-          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11
-          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12
-          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28
-          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around
--}
-
-date :: Int -> Int -> Int -> DateTime
-date y m d = DateTime y m d 0 0 0 0 0
-
-time :: Int -> Int -> Int -> Int -> Int -> DateTime
-time h m s ms z = DateTime 0 0 0 h m s ms z
-
-dtYear       :: DateTime -> Int
-dtMonth      :: DateTime -> Int
-dtDay        :: DateTime -> Int
-dtHour       :: DateTime -> Int
-dtMinute     :: DateTime -> Int
-dtSecond     :: DateTime -> Int
-dtMillisecs  :: DateTime -> Int
-dtTimezone   :: DateTime -> Int                -- time zone offset in minutes
-dtYear      ( DateTime x _ _ _ _ _ _ _ ) = x
-dtMonth     ( DateTime _ x _ _ _ _ _ _ ) = x
-dtDay       ( DateTime _ _ x _ _ _ _ _ ) = x
-dtHour      ( DateTime _ _ _ x _ _ _ _ ) = x
-dtMinute    ( DateTime _ _ _ _ x _ _ _ ) = x
-dtSecond    ( DateTime _ _ _ _ _ x _ _ ) = x
-dtMillisecs ( DateTime _ _ _ _ _ _ x _ ) = x
-dtTimezone  ( DateTime _ _ _ _ _ _ _ x ) = x
-
-lenFix     :: String -> Int -> String
-lenFix inStr newLen
-  | length inStr >= newLen  = inStr
-  | otherwise               = lenFix ('0':inStr) newLen
-
-showTZ     :: Int -> String
-showTZ tz
-  | tz<0         = "-" ++ showTZabs ( -tz )
-  | tz==0        = showTZabs ( tz )
-  | otherwise    = "+" ++ showTZabs ( tz )
-
-showTZabs  :: Int -> String
-showTZabs tz
-  | tz==0        = "Z"
-  | otherwise    = lenFix ( show ( tz `div` 60 ) ) 2 ++  ":" ++
-                   lenFix ( show ( tz `mod` 60 ) ) 2
-
-showTime :: DateTime -> String
-showTime ( DateTime yr mo da hr mi se ms tz )
-  | ms==0     = lenFix ( show hr ) 2 ++  ":" ++
-                lenFix ( show mi ) 2 ++  ":" ++
-                lenFix ( show se ) 2
-  | otherwise = lenFix ( show hr ) 2 ++ ":" ++
-                lenFix ( show mi ) 2 ++ ":" ++
-                lenFix ( show se ) 2 ++ "." ++
-                lenFix ( show ms ) 3
-
-showDate :: DateTime -> String
-showDate ( DateTime yr mo da hr mi se ms tz )
-  = lenFix ( show yr ) 4 ++ "-" ++
-    lenFix ( show mo ) 2 ++ "-" ++
-    lenFix ( show da ) 2
-
-dtShow     :: DateTime -> String             -- return string form
-dtShow ( DateTime yr mo da hr mi se ms tz )
-  = showDate ( DateTime yr mo da hr mi se ms tz ) ++ "T" ++
-    showTime ( DateTime yr mo da hr mi se ms tz ) ++ showTZ tz
-
-carryMins :: DateTime -> DateTime
-carryMins ( DateTime yr mo da hr mi se ms tz )
-  | newhrs >= 24 = carryHours ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )
-  | otherwise    = ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )
-  where
-    newhrs = (hr+(mi`div`60))
-
-carryHours :: DateTime -> DateTime
-carryHours ( DateTime yr mo da hr mi se ms tz )
-  = ( DateTime y m d (hr`mod`24) mi se ms tz )
-  where
-    (DateTime y m d _ _ _ _ _) = fromJulianDate ((toJulianDate yr mo da)+ (hr`div`24))
-
-normTZ :: DateTime -> DateTime
-normTZ ( DateTime yr mo da hr mi se ms tz )
-  = carryMins ( DateTime yr mo da hr (mi-tz) se ms 0 )
---  = addMinutes (-tz) ( DateTime yr mo da hr mi se ms tz )
-
-{- another way -}
-
-addMilliSecs addms ( DateTime yr mo da hr mi se ms tz )
-    | totms < 1000 = DateTime yr mo da hr mi se totms tz
-    | otherwise    = addSeconds addse ( DateTime yr mo da hr mi se newms tz )
-    where
-        totms = (ms+addms)
-        newms = totms `mod` 1000
-        addse = totms `div` 1000
-
-addSeconds addse ( DateTime yr mo da hr mi se ms tz )
-    | totse < 60 = DateTime yr mo da hr mi totse ms tz
-    | otherwise  = addMinutes addmi ( DateTime yr mo da hr mi newse ms tz )
-    where
-        totse = (se+addse)
-        newse = totse `mod` 60
-        addmi = totse `div` 60
-
-addMinutes addmi ( DateTime yr mo da hr mi se ms tz )
-    | totmi < 60 = DateTime yr mo da hr totmi se ms tz
-    | otherwise  = addHours addhr ( DateTime yr mo da hr newmi se ms tz )
-    where
-        totmi = (mi+addmi)
-        newmi = totmi `mod` 60
-        addhr = totmi `div` 60
-
-addHours addhr ( DateTime yr mo da hr mi se ms tz )
-    | tothr < 24 = DateTime yr mo da tothr mi se ms tz
-    | otherwise  = addDays addda ( DateTime yr mo da newhr mi se ms tz )
-    where
-        tothr = (hr+addhr)
-        newhr = tothr `mod` 24
-        addda = tothr `div` 24
-
-addDays addda ( DateTime yr mo da hr mi se ms tz )
-    = DateTime newyr newmo newda hr mi se ms tz
-    where
-        -- newdate = fromJulianDate (toJulianDate yr mo (da+addda) )
-        -- newyr   = dtYear newdate
-        -- newmo   = dtMonth newdate
-        -- newda   = dtDay newdate
-        DateTime newyr newmo newda _ _ _ _ _ = fromJulianDate ( (toJulianDate yr mo da)+addda )
-
-{- another way -}
-
-simpleEq :: DateTime -> DateTime -> Bool
---simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) == ( yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) )
-simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 == yr2 ) && ( mo1 == mo2 ) && ( da1 == da2 ) && ( hr1 == hr2 ) && ( mi1 == mi2 ) && ( se1 == se2 ) && ( ms1 == ms2 ) && ( tz1 == tz2 ) )
-
-simpleLT :: DateTime -> DateTime -> Bool
-simpleLT ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 )
-  | (yr1<yr2) = True
-  | (yr1==yr2)&&(mo1<mo2) = True
-  | (yr1==yr2)&&(mo1==mo2)&&(da1<da2) = True
-  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1<hr2) = True
-  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1<mi2) = True
-  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1<se2) = True
-  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1==se2)&&(ms1<ms2) = True
-  | otherwise = False
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/DateTime.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: DateTime.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.23  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.22  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.21  2003/02/21 14:35:10  ronan
--- Minor performance tweaks.
---
--- Revision 1.20  2003/02/17 13:15:13  ronan
--- fromJulianDate passed exhaustive 2299-3601
---
--- Revision 1.19  2003/02/15 13:44:29  graham
--- Added test output to file.
--- Still a bug around 2300-03-01
---
--- Revision 1.18  2003/02/15 12:00:30  graham
--- Fix 400-year roll-over bug
---
--- Revision 1.17  2003/02/14 20:33:43  ronan
--- fromJulianDate works.
---
--- Revision 1.16  2003/02/14 20:31:44  ronan
--- fromJulianDate works.
---
--- Revision 1.14  2003/02/14 10:22:06  graham
--- fromJulianDate works for dates before 2100
---
--- Revision 1.13  2003/02/13 13:01:55  graham
--- Added some test cases for fromJulianDate and comparison
--- with date rollover.  Currently not working.
---
--- Revision 1.12  2003/02/13 10:26:01  ronan
--- Minor tweaks to performance. Still passes tests.
---
--- Revision 1.11  2003/02/12 12:26:43  ronan
--- fromJulianDate now also working perfectly.
---
--- Revision 1.10  2003/02/12 11:57:02  ronan
--- Julian date stuff PERFECT!!!
---
--- Revision 1.9  2003/02/11 18:08:43  graham
--- Added loads of new test cases
--- Moved Julian date test cases to DateTimeTest
---
--- Revision 1.8  2003/02/11 16:04:28  ronan
--- Put Julian in DateTime and added normTZ functionality. Vaguely tested (2 cases).
---
--- Revision 1.7  2003/02/11 12:02:34  graham
--- Minor updates
--- Add some Julian date test cases
---
--- Revision 1.6  2003/02/11 10:47:17  ronan
--- Work on DateTime. (==) works as intended. Julian date work done, needs testing.
---
--- Revision 1.5  2003/02/10 14:21:57  ronan
--- Tests very bodged, but working. Show working to a good standard. (==) replaced with (===) for now. Next step: timezone correction.
---
--- Revision 1.2  2003/02/09 09:20:37  ronan
--- Working on DateTime in Haskell. Not working. Yet.
---
--- Revision 1.1  2003/02/07 18:46:07  graham
--- Add new date/time modules
--- Update copyright year
---
− Swish/HaskellUtils/ErrorM.hs 
@@ -1,122 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}---------------------------------------------------------------------------------
---  $Id: ErrorM.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ErrorM
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a Monad for reporting errors.  It is conceived as a
---  very simple extension of Maybe, except that the failure variant caries
---  a reason for failure.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.ErrorM
-    ( ErrorM(Error,Result)
-    , eitherErrMaybe
-    )
-where
-
-import Control.Monad
-    ( MonadPlus(..) )
-
-------------------------------------------------------------
---  ErrorM
-------------------------------------------------------------
-
--- |Error monad.
---
-data ErrorM a = Error String | Result a
-
--- |Monad instance for Error
-instance Monad ErrorM where
-    (Result a) >>= f = f a
-    (Error e)  >>= _ = Error e
-    return     = Result
-    fail e     = Error e
-
--- |MonadPlus instance for Error
-instance MonadPlus ErrorM where
-    mzero             = Error "No result"
-    mplus (Error _) r = r
-    mplus r         _ = r
-
-------------------------------------------------------------
---  Either
-------------------------------------------------------------
-
--- |Monad instance for (Either String b)
-instance Monad (Either String) where
-    (Left a)  >>= _ = Left a
-    (Right b) >>= f = f b
-    return          = Right
-    fail a          = Left a
-
--- |MonadPlus instance for (Either String b)
-instance MonadPlus (Either String) where
-    mzero             = Left "No result"
-    mplus (Left _) r  = r
-    mplus b        _  = b
-
--- |Map maybe to (Either String) error monad
-eitherErrMaybe :: String -> (a->b) -> Maybe a -> Either String b
-eitherErrMaybe err f mv = case mv of
-    Nothing -> Left  err
-    Just v  -> Right (f v)
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ErrorM.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ErrorM.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.5  2003/12/10 03:48:57  graham
--- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
---
--- Revision 1.4  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.3  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.2  2003/12/03 15:42:53  graham
--- Add instance declaration for MonadPlus
---
--- Revision 1.1  2003/12/01 21:14:39  graham
--- Added module ErrorM
---
− Swish/HaskellUtils/FunctorM.hs 
@@ -1,105 +0,0 @@---------------------------------------------------------------------------------
---  $Id: FunctorM.hs,v 1.2 2004/01/13 17:12:08 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  FunctorM
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a monadic functor class, that allows a monadic
---  computation to be performed, functor-style, over some container
---  structure.  The advantage of this compared with a normal functor
---  is that it allows values to be accumulated from the computation
---  (in a Monad instance) at the same time as (optionally) applying
---  transformations to each of the contained values.
---
---  Acknowledgement:  based on a message by Tomasz Zielonka sent to
---  the Haskell mailing list on 4 June 2003.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.FunctorM
-    ( FunctorM(..)
-    )
-where
-
-class FunctorM t where
-    fmapM  :: Monad m => (a -> m b) -> (t a -> m (t b))
-    -- Try to generalise accumulating values?
-    -- fmapQM :: Monad m => m b -> (b -> a -> m b) -> (t a -> m b)
-    fmapM_ :: Monad m => (a -> m b) -> (t a -> m ())
-    fmapM_ f t = fmapM f t >> return ()
-
-instance FunctorM [] where
-    fmapM  = mapM
-    fmapM_ = mapM_
-
-{-  Another example:
-
-data Arc lb = Arc { asubj, apred, aobj :: lb }
-    deriving (Eq, Show)
-
-instance Functor Arc where
-    fmap f (Arc s p o) = Arc (f s) (f p) (f o)
-
-instance FunctorM Arc where
-    -- fmapM :: (lb -> m l2) -> Arc lb -> m (Arc l2)
-    fmapM f (Arc s p o) =
-        do  { s' <- f s
-            ; p' <- f p
-            ; o' <- f o
-            ; return $ Arc s' p' o'
-            }
-
--}
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/FunctorM.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: FunctorM.hs,v $
--- Revision 1.2  2004/01/13 17:12:08  graham
--- Complete functionality of AccumulateM, using functional dependencies
--- in the MonadAccum type class.
---
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.3  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.2  2003/06/12 00:49:04  graham
--- Basic query processor runs test cases OK.
--- Proof framework compiles, not yet tested.
---
--- Revision 1.1  2003/06/10 17:34:29  graham
--- Create FunctorM module
---
− Swish/HaskellUtils/ListHelpers.hs 
@@ -1,495 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ListHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ListHelpers
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines some generic list and related helper functions.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.ListHelpers
-      ( select, mapset, deleteIndex
-      , subset, equiv, hasPartitions, addSetElem
-      , headOrNothing
-      , pairUngroup, pairsUngroup, pairSort, pairGroup
-      , breakAll
-      , powerSet, combinations
-      , permutations, listProduct
-      , powerSequences, powerSequences_len, powerSequences_inf
-      , flist, ffold, allf, anyf, allp, anyp )
-where
-
-import Data.List( union, intersect, sortBy, groupBy )
-
-------------------------------------------------------------
---  Generic helpers
-------------------------------------------------------------
-
--- |Select is like filter, except that it tests one list to select
---  elements from a second list.
-select :: ( a -> Bool ) -> [a] -> [b] -> [b]
-select _ [] []           = []
-select f (e1:l1) (e2:l2)
-    | f e1      = e2:(select f l1 l2)
-    | otherwise = (select f l1 l2)
-select _ _ _    = error "select supplied with different length lists"
-
--- |Collect set of values from list under supplied mapping function
-mapset :: Eq b => ( a -> b ) -> [a] -> [b]
-mapset _ []    = []
-mapset f (e:l) = [f e] `union` (mapset f l)
-
--- |Delete the n'th element of a list, returning the result
---
---  If the list doesn't have an n'th element, return the list unchanged.
---
-deleteIndex :: [a] -> Int -> [a]
-deleteIndex [] _ = []
-deleteIndex xxs@(x:xs) n
-    | n <  0    = xxs
-    | n == 0    = xs
-    | otherwise = x:deleteIndex xs (n-1)
-
-{-
-testdi1 = deleteIndex [1,2,3,4] 0    == [2,3,4]
-testdi2 = deleteIndex [1,2,3,4] 1    == [1,3,4]
-testdi3 = deleteIndex [1,2,3,4] 2    == [1,2,4]
-testdi4 = deleteIndex [1,2,3,4] 3    == [1,2,3]
-testdi5 = deleteIndex [1,2,3,4] 4    == [1,2,3,4]
-testdi6 = deleteIndex [1,2,3,4] (-1) == [1,2,3,4]
-testdi = and
-    [ testdi1, testdi2, testdi3, testdi4, testdi5, testdi6 ]
--}
-
-------------------------------------------------------------
---  Set functions
-------------------------------------------------------------
-
--- |Subset test
-
-subset          :: (Eq a) => [a] -> [a] -> Bool
-a `subset` b    = and [ ma `elem` b | ma <- a ]
-
--- |Set equivalence test
-
-equiv           :: (Eq a) => [a] -> [a] -> Bool
-a `equiv` b     = (a `subset` b) && (b `subset` a)
-
--- |Set partition test
---
---  Is it possible to be more efficient here?
---  Maybe something like sort/merge/compare?
-hasPartitions   :: (Eq a) => [a] -> ([a],[a]) -> Bool
-a `hasPartitions` (b1,b2) =
-    (null (b1 `intersect` b2)) && (a `equiv` (b1 `union` b2))
-
--- |Add element to set
-
-addSetElem :: (Eq a) => a -> [a] -> [a]
-addSetElem e es = if e `elem` es then es else e:es
-
-------------------------------------------------------------
---  Lists and Maybes
-------------------------------------------------------------
-
--- |Return head of a list of Maybe's, or Nothing if list is empty
---
---  Use with 'filter isJust' to select a non-Nothing value from a
---  list when such a value is present.
---
-headOrNothing :: [Maybe a] -> Maybe a
-headOrNothing []    = Nothing
-headOrNothing (a:_) = a
-
-------------------------------------------------------------
---  Filter, ungroup, sort and group pairs by first member
-------------------------------------------------------------
-
-pairSelect :: ((a,b) -> Bool) -> ((a,b) -> c) -> [(a,b)] -> [c]
-pairSelect p f as = map f (filter p as)
-
-pairUngroup :: (a,[b]) -> [(a,b)]
-pairUngroup (a,bs) = [ (a,b) | b <- bs ]
-
-pairsUngroup :: [(a,[b])] -> [(a,b)]
-pairsUngroup ps = [ (a,b) | (a,bs) <- ps, b <- bs ]
-
-pairSort :: (Ord a) => [(a,b)] -> [(a,b)]
-pairSort ps = sortBy compareFirst ps
-    where
-        compareFirst (a1,_) (a2,_) = compare a1 a2
-
-pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])]
-pairGroup ps = map (factor . unzip) $ groupBy eqFirst $ pairSort ps
-    where
-        factor ((a:_),bs)     = (a,bs)
-        eqFirst (a1,_) (a2,_) = a1 == a2
-
-------------------------------------------------------------
---  Separate list into sublists
-------------------------------------------------------------
-
--- |Break list into a list of sublists, separated by element
---  satisfying supplied condition.
-breakAll :: (a -> Bool) -> [a] -> [[a]]
-breakAll _ [] = []
-breakAll p s  = let (h,s') = break p s
-                    in h : breakAll p (drop 1 s')
-
-------------------------------------------------------------
---  Powerset
-------------------------------------------------------------
-
---  [[[TBD... there's a much better implementation in my email,
---     from Christopher Hendrie.  This is the raw code.]]]
-{-
->ranked_powerset :: [a] -> [[[a]]]
->ranked_powerset = takeWhile (not . null) . foldr next_powerset ([[]] :
-repeat [])
->
->next_powerset :: a -> [[[a]]] -> [[[a]]]
->next_powerset x r = zipWith (++) ([] : map (map (x:)) r) r
->
->powerset :: [a] -> [[a]]
->powerset = tail . concat . ranked_powerset
--}
-
--- |Powerset of a list, in ascending order of size.
---  Assumes the supplied list has no duplicate elements.
-powerSet :: [a] -> [[a]]
-powerSet as =
-    concatMap (flip combinations as) [1..length as]
-
--- |Combinations of n elements from a list, each being returned in the
---  order that they appear in the list.
-combinations :: Int -> [a] -> [[a]]
-combinations _ []       = []        -- Don't include empty combinations
-combinations n as@(ah:at)
-    | n <= 0            = [[]]
-    | n >  length as    = []
-    | n == length as    = [as]
-    | otherwise         = (map (ah:) $ combinations (n-1) at) ++
-                          (combinations n at)
-
-{-
--- |Return list of integers from lo to hi.
-intRange :: Int -> Int -> [Int]
-intRange lo hi = take (hi-lo+1) (iterate (+1) 1)
--}
-
-{-
--- Tests
-testcomb0 = combinations 0 "abcd" -- []
-testcomb1 = combinations 1 "abcd" -- ["a","b","c","d"]
-testcomb2 = combinations 2 "abcd" -- ["ab","ac","ad","bc","bd","cd"]
-testcomb3 = combinations 3 "abcd" -- ["abc","abd","acd","bcd"]
-testcomb4 = combinations 4 "abcd" -- ["abcd"]
-testcomb5 = combinations 5 "abcd" -- []
-testpower = powerSet "abc"        -- ["a","b","c","ab","ac","bc","abc"]
--}
-
-------------------------------------------------------------
---  Permutations of a list
-------------------------------------------------------------
-
---  This algorithm is copied from an email by S.D.Mechveliani
---  http://www.dcs.gla.ac.uk/mail-www/haskell/msg01936.html
-permutations :: [a] -> [[a]]
-permutations    []     = [[]]
-permutations    (j:js) = addOne $ permutations js
-    where
-        addOne []       = []
-        addOne (ks:pms) = (ao ks)++(addOne pms)
-        ao []           = [[j]]
-        ao (k:ks)       = (j:k:ks):(map (k:) $ ao ks)
-
-{-
-testperm = permutations [1,2,3] ==
-    [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
--}
-
-------------------------------------------------------------
---  List product
-------------------------------------------------------------
-
--- |Given a list of lists, construct a new list of lists where
---  each member of the new list is the same length as the original
---  list, and each member corresponds to a different choice of
---  one element from each of the original members in the
---  corresponding position.  Thus:
---
---  listProduct [[a1,a2],[b1],[c1,c2]] =
---       [ [a1,b1,c1], [a1,b1,c2], [a2,b1,c1], [a2,b1,c2] ]
---
---  Note:  The length of the resulting list is the prodicty of
---  lengths of the components of the original list.  Thus, if
---  any member of the original list is empty then so is the
---  resulting list:
---
---  listProduct [[a1,a2],[],[c1,c2]] = []
---
---  NOTE:  this is subsumed by 'sequence'
---
-listProduct :: [[a]] -> [[a]]
-listProduct []       = [[]]
-listProduct (as:ass) = concat [ map (a:) (listProduct ass) | a <- as ]
-
-{-
-test1 = listProduct [["a1","a2"],["b1"],["c1","c2"]]
-test2 = listProduct [["a1","a2"],[],["c1","c2"]]
-
-lp []       = [[]]
-lp (as:ass) = concatMap (\a -> (map (a:) (lp ass))) as
--}
-
-------------------------------------------------------------
---  Powersequence (?) -- all sequences from some base values
-------------------------------------------------------------
-
--- |Function to choose all sequences of any length
---  from a supplied set of values, returned in
---  increasing length.
-powerSequences :: [a] -> [[a]]
-powerSequences rs = concat $ powerSeq_bylen rs [[]]
-
--- |Construct list of lists of sequences of increasing length
-powerSeq_bylen :: [a] -> [[a]] -> [[[a]]]
-powerSeq_bylen rs ps = (ps:powerSeq_bylen rs ns) where ns = powerSeq_next rs ps
-
--- |Return sequences of length n+1 given original sequence
---  and list of all sequences of length n
-powerSeq_next :: [a] -> [[a]] -> [[a]]
-powerSeq_next rs rss = [ h:t | t <- rss, h <- rs ]
-
--- |Return all powersequences of a given length
-powerSequences_len :: Int -> [a] -> [[a]]
-powerSequences_len len rs = head $ drop len $ powerSeq_bylen rs [[]]
-
--- |Return all powersequences of indefinite length
---  Observe that any such powersequence will consist of a sequence
---  of a finite length sequence followed by an indefinite number of
---  copies of the head of the base set.  To prevent duplicates, the
---  generator constructs only sequences that do not end in the first
---  member of the base set.
-powerSequences_inf :: [a] -> [[a]]
-powerSequences_inf rs =
-    map (++pst) $ []:(concat $ powerSeq_bylen rs psh)
-    where
-        psh = map (:[]) (tail rs)
-        pst = repeat $ head rs
-
-{- Powersequence tests
-t0 = [1,2,3,4,5,6]
-t1 = powerSequences t0
-t2 = take 15 t1
-t3 = powerSequences_len 3 t0
-t4 = powerSequences_inf t0
-t5 = map (take 6) $ take 15 t4
-t6 = take 15 (powerSequences_len 6 t0)
-t7 = t5 == t6
-t8 = powerSequences_len1 3 t0
-t9 = t8 == t3
--}
-
-------------------------------------------------------------
---  Functions, lists and monads
-------------------------------------------------------------
-
--- |Apply list of functions to some value, returning list of results.
---  It's kind of like an converse map.
---
---  This is similar to the 'ap' function in the Monad library.
---
-flist :: [a->b] -> a -> [b]
-flist fs a = map ($ a) fs
-
-{-
-flisttest = flist [(1*),(2*),(3*)] 5 -- [5,10,15]
--}
-
--- |A more generalized form of flist that works with arbitrary Monads.
---  (Suggested by Derek Elkin.)
-
-fmonad :: Monad m => m (a->b) -> a -> m b
-fmonad fm a =
-    do  { f <- fm
-        ; return $ f a
-        }
-
-{-
-fmonadtest = fmonad [(1*),(2*),(3*)] 3 -- [3,6,9]
--}
-
--- |Fold result from list of functions applied to some value,
---  returning the result of the fold.
---
---  This is similar to the 'ap' function in the Monad library.
---
-ffold :: (b->c->c) -> c -> [a->b] -> a -> c
-ffold rf ri fs v = foldr rf ri (flist fs v)
-
-{-
-ffoldtest0 = ffold ge4and True [(1+),(2+),(3+)] 0     -- False
-ffoldtest1 = ffold ge4and True [(1+),(2+),(3+)] 1     -- False
-ffoldtest2 = ffold ge4and True [(1+),(2+),(3+)] 2     -- False
-ffoldtest3 = ffold ge4and True [(1+),(2+),(3+)] 3     -- True
-ge4and v b = (v>=4 && b)
-ffoldtest  = and [not ffoldtest0,not ffoldtest1,not ffoldtest2,ffoldtest3]
--}
-
--- |Test if application of all functions in list to a given value
---  satisfies a given condition
---
-allf :: (b->Bool)  -> [a->b] -> a -> Bool
-allf pf fs a = all pf (flist fs a)
-
-{-
-allftest0 = allf (>=4) [(1+),(2+),(3+)] 0     -- False
-allftest1 = allf (>=4) [(1+),(2+),(3+)] 1     -- False
-allftest2 = allf (>=4) [(1+),(2+),(3+)] 2     -- False
-allftest3 = allf (>=4) [(1+),(2+),(3+)] 3     -- True
-allftest  = and [not allftest0,not allftest1,not allftest2,allftest3]
--}
-
--- |Test if application of any functions in list to a given value
---  satisfies a given condition
---
-anyf :: (b->Bool)  -> [a->b] -> a -> Bool
-anyf pf fs a = any pf (flist fs a)
-
-{-
-anyftest0 = anyf (>=4) [(1+),(2+),(3+)] 0     -- False
-anyftest1 = anyf (>=4) [(1+),(2+),(3+)] 1     -- True
-anyftest2 = anyf (>=4) [(1+),(2+),(3+)] 2     -- True
-anyftest3 = anyf (>=4) [(1+),(2+),(3+)] 3     -- True
-anyftest  = and [not anyftest0,anyftest1,anyftest2,anyftest3]
--}
-
--- |Test if a value satisfies all predicates in a list
---
-allp :: [a->Bool] -> a -> Bool
-allp ps a = and (flist ps a)
-
-{-
-allptest0 = allp [(>=1),(>=2),(>=3)] 0     -- False
-allptest1 = allp [(>=1),(>=2),(>=3)] 1     -- False
-allptest2 = allp [(>=1),(>=2),(>=3)] 2     -- False
-allptest3 = allp [(>=1),(>=2),(>=3)] 3     -- True
-allptest  = and [not allptest0,not allptest1,not allptest2,allptest3]
--}
-
--- |Test if a value satisfies any predicate in a list
---
-anyp :: [a->Bool] -> a -> Bool
-anyp ps a = or (flist ps a)
-
-{-
-anyptest0 = anyp [(>=1),(>=2),(>=3)] 0     -- False
-anyptest1 = anyp [(>=1),(>=2),(>=3)] 1     -- True
-anyptest2 = anyp [(>=1),(>=2),(>=3)] 2     -- True
-anyptest3 = anyp [(>=1),(>=2),(>=3)] 3     -- True
-anyptest  = and [not anyptest0,anyptest1,anyptest2,anyptest3]
--}
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ListHelpers.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ListHelpers.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.16  2003/11/28 00:17:55  graham
--- Datatype constraint test cases all passed.
---
--- Revision 1.15  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.14  2003/10/24 21:05:09  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.13  2003/10/16 16:01:49  graham
--- Reworked RDFProof and RDFProofContext to use new query binding
--- framework.  Also fixed a bug in the variable binding filter code that
--- caused failures when a variable used was not bound.
---
--- Revision 1.12  2003/10/14 20:31:21  graham
--- Add separate module for generic variable binding functions.
---
--- Revision 1.11  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.10  2003/06/27 20:46:00  graham
--- Coded initial version of RDF simple entailment rule.
--- New rule still needs testing, but other test cases still OK.
---
--- Revision 1.9  2003/06/18 14:59:27  graham
--- Augmented query variable binding structure.
--- RDFQuery tests OK.
---
--- Revision 1.8  2003/06/18 01:29:29  graham
--- Fixed up some problems with backward chaining queries.
--- Query test cases still to complete.
--- Proof incomplete.
---
--- Revision 1.7  2003/06/10 01:04:46  graham
--- Proof framework in progress;  compiles, incomplete
---
--- Revision 1.6  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.5  2003/05/29 00:57:37  graham
--- Resolved swish performance problem, which turned out to an inefficient
--- method used by the parser to add arcs to a graph.
---
--- Revision 1.4  2003/05/20 17:28:51  graham
--- Added 'breakAll' function
---
--- Revision 1.3  2003/05/14 02:01:59  graham
--- GraphMatch recoded and almost working, but
--- there are a couple of
--- obscure bugs that are proving rather stubborn to squash.
---
--- Revision 1.2  2003/05/09 00:28:48  graham
--- Added partitionBy to ListHelpers (may want to remove since
--- it's also in the standard List module).
--- Added mapSelect and mapMerge to LookupMap, and test cases.
---
--- Revision 1.1  2003/04/11 18:12:10  graham
--- Renamed GraphHelpers to ListHelpers
--- LookupMapTest, GraphTest, RDFGraphTest all run OK
---
− Swish/HaskellUtils/LookupMap.hs 
@@ -1,564 +0,0 @@-{-# OPTIONS -XMultiParamTypeClasses #-}-{-# OPTIONS  -XFunctionalDependencies #-}-{-# OPTIONS  -XFlexibleContexts #-}-{-# OPTIONS  -XFlexibleInstances #-}-{-# OPTIONS  -XTypeSynonymInstances  #-}---------------------------------------------------------------------------------
---  $Id: LookupMap.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  LookupMap
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98, class dependencies
---
---  This module defines a lookup table format and associated functions
---  used by the graph matching code.
---
---------------------------------------------------------------------------------
-
-------------------------------------------------------------
---  Generic list-of-pairs lookup functions
-------------------------------------------------------------
-
-module Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , emptyLookupMap, makeLookupMap, listLookupMap
-    , reverseLookupMap
-    , keyOrder
-    , mapFind, mapFindMaybe, mapContains
-    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap
-    , mapAdd, mapAddIfNew
-    , mapDelete, mapDeleteAll
-    , mapApplyToAll, mapTranslate
-    , mapEq, mapKeys, mapVals
-    , mapSelect, mapMerge
-    , mapSortByKey, mapSortByVal
-    , mapTranslateKeys, mapTranslateVals
-    , mapTranslateEntries, mapTranslateEntriesM
-    )
-where
-
-import Data.List( nub, sortBy )
--import Swish.HaskellUtils.ListHelpers ( equiv )
-
-------------------------------------------------------------
---  Class for lookup map entries
-------------------------------------------------------------
-
--- |LookupEntryClass defines essential functions of any datatype
---  that can be used to make a LookupMap.
---
---  Minimal definition: newEntry and keyVal
---
-class (Eq k, Show k) => LookupEntryClass a k v | a -> k, a -> v
-    where
-        newEntry    :: (k,v) -> a
-        keyVal      :: a -> (k,v)
-        entryKey    :: a -> k
-        entryKey e = k where (k,_) = keyVal e
-        entryVal    :: a -> v
-        entryVal e = v where (_,v) = keyVal e
-        entryEq     :: (Eq v) => a -> a -> Bool
-        entryEq e1 e2 = (keyVal e1) == (keyVal e2)
-        entryShow   :: (Show v) => a -> String
-        entryShow e = (show k)++":"++(show v) where (k,v) = keyVal e
-        kmap :: (LookupEntryClass a2 k2 v) => (k -> k2) -> a -> a2
-        kmap f e    = newEntry (f $ entryKey e,entryVal e)
-        vmap :: (LookupEntryClass a2 k v2) => (v -> v2) -> a -> a2
-        vmap f e    = newEntry (entryKey e,f $ entryVal e)
-
--- |Predefine a pair of appropriate values as a valid lookup table entry
---  (i.e. an instance of LookupEntryClass).
---
-instance (Eq k, Show k) => LookupEntryClass (k,v) k v where
-    newEntry = id
-    keyVal   = id
-
--- |Define a lookup map based on a list of values.
---
---  Note:  the class constraint that a is an instance of LookupEntryClass
---  is not defined here, for good reasons (which I forget right now, but
---  something to do with the method disctionary being superfluous on
---  an algebraic data type).
---
-data LookupMap a = LookupMap [a]
-
--- |Define eqiality of LookupMap values based on equality of entries.
---
---  (This is possibly a poor definition, as it is dependent on ordering
---  of list members.  But it passes all current test cases, and is used
---  only for testing.)
---
---  See also mapEq
---  (why not just use that here?  I don't know:  it's probably historic.)
---
-instance (Eq a) => Eq (LookupMap a) where
-    LookupMap es1 == LookupMap es2 = es1 == es2
-
--- |Define Show instance for LookupMap based on Showing the
--- list of entries.
---
-instance (Show a ) => Show (LookupMap a) where
-    show (LookupMap es) = "LookupMap " ++ show es
-
--- |Empty lookup map of arbitrary (i.e. polymorphic) type.
---
-emptyLookupMap :: (LookupEntryClass a k v) => LookupMap a
-emptyLookupMap = LookupMap []
-
--- |Function to create a LookupMap from a list of entries.
---
---  Currently, this is trivial but future versions could be
---  more substantial.
---
-makeLookupMap :: (LookupEntryClass a k v) => [a] -> LookupMap a
-makeLookupMap es = LookupMap es
-
--- |Return list of lookup map entries.
---
---  Currently, this is trivial but future versions could be
---  more substantial.
---
-listLookupMap :: (LookupEntryClass a k v) => LookupMap a -> [a]
-listLookupMap (LookupMap es) = es
-
--- |Given a lookup map entry, return a new entry that can be used
---  in the reverse direction of lookup.  This is used to construct
---  a reverse LookupMap.
---
-reverseEntry :: (LookupEntryClass a1 k v, LookupEntryClass a2 v k)
-    => a1 -> a2
-reverseEntry e = newEntry (v,k) where (k,v) = keyVal e
-
--- |Given a lookup map, return a new map that can be used
---  in the opposite direction of lookup.
---
-reverseLookupMap :: (LookupEntryClass a1 b c, LookupEntryClass a2 c b)
-    => LookupMap a1 -> LookupMap a2
-reverseLookupMap (LookupMap es) = LookupMap (map reverseEntry es)
-
--- |Given a pair of lookup entry values, return the ordering of their
---  key values.
---
-keyOrder :: (LookupEntryClass a k v, Ord k)
-    =>  a -> a -> Ordering
-keyOrder e1 e2 = compare k1 k2
-    where
-        (k1,_) = keyVal e1
-        (k2,_) = keyVal e2
-
---  Local helper function to build a new LookupMap from
---  a new entry and an exiting map.
---
-mapCons :: (LookupEntryClass a k v) =>
-    a -> LookupMap a -> LookupMap a
-mapCons e (LookupMap es) = LookupMap (e:es)
-
--- |Find key in lookup map and return corresponding value,
---  otherwise return default supplied.
---
-mapFind :: (LookupEntryClass a k v) => v -> k -> LookupMap a -> v
-mapFind def key (LookupMap es) = foldr match def es where
-    match ent alt
-        | key == (entryKey ent) = entryVal ent
-        | otherwise             = alt
-
--- |Find key in lookup map and return Just the corresponding value,
---  otherwise return Nothing.
---
-mapFindMaybe :: (LookupEntryClass a k v) => k -> LookupMap a -> Maybe v
-mapFindMaybe key (LookupMap es) = foldr match Nothing es where
-    match ent alt
-        | key == (entryKey ent) = Just (entryVal ent)
-        | otherwise             = alt
-
--- |Test to see if key is present in the supplied map
---
-mapContains :: (LookupEntryClass a k v) =>
-    LookupMap a -> k -> Bool
-mapContains (LookupMap es) key  = or (map match es) where
-    match ent = key == (entryKey ent)
-
--- |Replace an existing occurrence of a key a with a new key-value pair
---  The resulting lookup map has the same form as the original in all
---  other respects.  Assumes exactly one occurrence of the supplied key.
---
-mapReplace :: (LookupEntryClass a k v) =>
-    LookupMap a -> a -> LookupMap a
-mapReplace (LookupMap (e:es)) newe
-    | (entryKey e) == (entryKey newe)   = LookupMap (newe:es)
-    | otherwise                         = mapAdd more e where
-        more = mapReplace (LookupMap es) newe
-mapReplace _ newe =
-    error ("mapReplace: Key value not found in lookup table: "++
-           (Prelude.show (entryKey newe)))
-
--- |Replace an existing occurrence of a key a with a new key-value pair,
---  or add a new key-value pair if the supplied key is not already present.
---
-mapReplaceOrAdd :: (LookupEntryClass a k v) =>
-    a -> LookupMap a -> LookupMap a
-mapReplaceOrAdd newe (LookupMap (e:es))
-    | (entryKey e) == (entryKey newe)   = LookupMap (newe:es)
-    | otherwise                         = mapCons e more where
-        more = mapReplaceOrAdd newe (LookupMap es)
-mapReplaceOrAdd newe (LookupMap [])     = LookupMap [newe]
-
--- |Replace any occurrence of a key a with a new key-value pair
---  The resulting lookup map has the same form as the original in all
---  other respects.
---
-mapReplaceAll :: (LookupEntryClass a k v) =>
-    LookupMap a -> a -> LookupMap a
-mapReplaceAll (LookupMap (e:es)) newe   = mapCons e' more where
-    more = mapReplaceAll (LookupMap es) newe
-    e'   = if (entryKey e) == (entryKey newe) then newe else e
-mapReplaceAll (LookupMap []) _          = (LookupMap [])
-
--- |Replace any occurrence of a key in the first argument with a
---  corresponding key-value pair from the second argument, if present.
---
---  This could be implemented by multiple applications of mapReplaceAll,
---  but is arranged differently so that only one new LookupMap value is
---  created.
---
---  Note:  keys in the new map that are not present in the old map
---  are not included in the result map
---
-mapReplaceMap :: (LookupEntryClass a k v) =>
-    LookupMap a -> LookupMap a -> LookupMap a
-mapReplaceMap (LookupMap (e:es)) newmap = mapCons e' more where
-    more  = mapReplaceMap (LookupMap es) newmap
-    e'    = newEntry (k,mapFind v k newmap)
-    (k,v) = keyVal e
-mapReplaceMap (LookupMap []) _ = (LookupMap [])
-
--- |Add supplied key-value pair to the lookup map.
---
---  This is effectively an optimized case of MapReplaceOrAdd or mapAddIfNew,
---  where the caller guarantees to avoid duplicate key values.
---
-mapAdd :: (LookupEntryClass a k v) =>
-    LookupMap a -> a -> LookupMap a
-mapAdd emap e = mapCons e emap
-
--- |Add supplied key-value pair to the lookup map,
---  only if the key value is not already present.
---
-mapAddIfNew :: (LookupEntryClass a k v) =>
-    LookupMap a -> a -> LookupMap a
-mapAddIfNew emap e = if mapContains emap (entryKey e)
-                        then emap
-                        else mapCons e emap
-
--- ADelete supplied key value from the lookup map.
---  This function assumes exactly one occurrence.
---
-mapDelete :: (LookupEntryClass a k v) =>
-    LookupMap a -> k -> LookupMap a
-mapDelete (LookupMap (e:es)) k
-    | k == (entryKey e) = LookupMap es
-    | otherwise         = mapCons e more where
-        more = mapDelete (LookupMap es) k
-mapDelete _ k =
-    error ("mapDelete: Key value not found in lookup table: "++(Prelude.show k))
-
--- |Delete any occurrence of a supplied key value from the lookup map.
---
-mapDeleteAll :: (LookupEntryClass a k v) =>
-    LookupMap a -> k -> LookupMap a
-mapDeleteAll (LookupMap (e:es)) k =
-    if (entryKey e) == k then more else mapCons e more where
-        more = mapDeleteAll (LookupMap es) k
-mapDeleteAll (LookupMap []) _ = (LookupMap [])
-
--- |Return a list of values obtained by applying a function to each key
---  in the map.  Creates an alternative set of values that can be
---  retrieved using mapTranslate.
---
-mapApplyToAll :: (LookupEntryClass a k v) =>
-    LookupMap a -> (k -> w) -> [w]
-mapApplyToAll (LookupMap es) f = [ f (entryKey e) | e <- es ]
-
--- |Find a node in a lookup map list, and returns the
---  corresponding value from a supplied list.  The appropriate ordering
---  of the list is not specified here, but an appropriately ordered list
---  may be obtained by mapApplyToAll.
---
-mapTranslate :: (LookupEntryClass a k v) =>
-    LookupMap a -> [w] -> k -> w -> w
-mapTranslate (LookupMap (e:es)) (w:ws) k def
-    | k == (entryKey e) = w
-    | otherwise         = mapTranslate (LookupMap es) ws k def
-mapTranslate _ _ _ def = def
-
--- |Compare two lookup maps for equality.
---
---  Two maps are equal if they have the same set of keys, and if
---  each key maps to an equivalent value.
---
-mapEq :: (LookupEntryClass a k v, Eq v) =>
-    LookupMap a -> LookupMap a -> Bool
-mapEq es1 es2 =
-    ( ks1 `equiv` ks2 ) &&
-    and [ (mapFindMaybe k es1) == (mapFindMaybe k es2) | k <- ks1 ]
-    where
-        ks1 = mapKeys es1
-        ks2 = mapKeys es2
-
--- |Return the list of keys in a supplied LookupMap
---
-mapKeys :: (LookupEntryClass a k v) =>
-    LookupMap a -> [k]
-mapKeys (LookupMap es) = nub $ map (fst . keyVal) es
-
--- |Return list of distinct values in a supplied LookupMap
---
-mapVals :: (Eq v, LookupEntryClass a k v) =>
-    LookupMap a -> [v]
-mapVals (LookupMap es) = nub $ map (snd . keyVal) es
-
--- |Select portion of a lookup map that corresponds to
---  a supplied list of keys
---
-mapSelect :: (LookupEntryClass a k v) =>
-    LookupMap a -> [k] -> LookupMap a
-mapSelect (LookupMap es) ks =
-    LookupMap $ filter (keyIn ks) es
-    where
-        keyIn ks e = k `elem` ks where (k,_) = keyVal e
-
--- |Merge two lookup maps, ensuring that if the same key appears
---  in both maps it is associated with the same value.
---
-mapMerge :: (LookupEntryClass a k v, Eq a, Show a, Ord k) =>
-    LookupMap a -> LookupMap a -> LookupMap a
-mapMerge (LookupMap es1) (LookupMap es2) =
-    LookupMap $ merge (sortBy keyOrder es1) (sortBy keyOrder es2)
-    where
-        merge es1 [] = es1
-        merge [] es2 = es2
-        merge es1@(e1:et1) es2@(e2:et2) =
-            case keyOrder e1 e2 of
-                LT -> e1:(merge et1 es2)
-                GT -> e2:(merge es1 et2)
-                EQ -> if e1 /= e2
-                        then error ("mapMerge key conflict: " ++ (show e1)
-                                    ++ " with " ++ (show e2))
-                        else e1:(merge et1 et2)
-
--- |Creates a new map that is the same as the supplied map, except
---  that its entries are sorted by key value.
---
---  (What's this used for?  It should be redundant.)
---
-mapSortByKey :: (LookupEntryClass a k v, Ord k) =>
-    LookupMap a -> LookupMap a
-mapSortByKey (LookupMap es) =
-    LookupMap $ sortBy keyCompare es
-    where
-        keyCompare e1 e2 = compare (entryKey e1) (entryKey e2)
-
--- |Creates a new map that is the same as the supplied map, except
---  that its entries are sorted by key value.
---
---  (What's this used for?  It should be redundant.)
---
-mapSortByVal :: (LookupEntryClass a k v, Ord v) =>
-    LookupMap a -> LookupMap a
-mapSortByVal (LookupMap es) =
-    LookupMap $ sortBy valCompare es
-    where
-        valCompare e1 e2 = compare (entryVal e1) (entryVal e2)
-
--- |An fmap-like function that returns a new lookup map that is a
---  copy of the supplied map with entry keys replaced according to
---  a supplied function.
---
-mapTranslateKeys :: (LookupEntryClass a1 k1 v, LookupEntryClass a2 k2 v) =>
-    (k1 -> k2) -> LookupMap a1 -> LookupMap a2
-mapTranslateKeys f (LookupMap es) =
-    LookupMap $ map (kmap f) es
-
--- |An fmap-like function that returns a new lookup map that is a
---  copy of the supplied map with entry values replaced according to
---  a supplied function.
---
-mapTranslateVals :: (LookupEntryClass a1 k v1, LookupEntryClass a2 k v2) =>
-    (v1 -> v2) -> LookupMap a1 -> LookupMap a2
-mapTranslateVals f = mapTranslateEntries (vmap f)
-
--- |A function that returns a new lookup map that is a copy of the
---  supplied map with complete entries replaced according to
---  a supplied function.
---
-mapTranslateEntries ::
-    (a1 -> a2) -> LookupMap a1 -> LookupMap a2
-mapTranslateEntries f (LookupMap es) =
-    LookupMap $ map f es
-
--- |A monadic form of mapTranslateEntries
---
-mapTranslateEntriesM :: (Monad m)
-    => (a1 -> m (a2)) -> LookupMap a1 -> m (LookupMap a2)
-mapTranslateEntriesM f (LookupMap es) =
-    do  { m2 <- mapM f es
-        ; return $ LookupMap m2
-        }
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/LookupMap.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: LookupMap.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.29  2003/12/07 19:10:35  graham
--- Cleaned up LookupMap code comments.
---
--- Revision 1.28  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.27  2003/12/03 22:04:00  graham
--- Re-ordered mapFind (again), to simplify currying of default value.
---
--- Revision 1.26  2003/12/03 22:02:09  graham
--- Re-ordered mapFind, to simplify currying of default value.
---
--- Revision 1.25  2003/11/24 15:46:03  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.24  2003/11/13 01:13:48  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.23  2003/10/24 21:02:42  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.22  2003/10/23 18:54:00  graham
--- Moved context requirements for using LookupMap.
--- Some context requirements are now applied to individual
--- LoopkupMap routines that depend upon them.
---
--- Revision 1.21  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.20  2003/06/30 19:07:00  graham
--- Instance entailment, subgraph entailment and simple entailment
--- tests now working.
---
--- Revision 1.19  2003/06/13 21:40:08  graham
--- Graph closure forward chaining works.
--- Backward chaining generates existentials.
--- Some problems with query logic for backward chaining.
---
--- Revision 1.18  2003/06/11 14:07:53  graham
--- Added mapTranslateEntriesM, which performs monadic translation of
--- LookupMap entries.  (Tested using Maybe monad.)
---
--- Revision 1.17  2003/06/10 17:38:34  graham
--- Remove some unneeded calss constraints from data type declarations
--- Reworked NSGraph to be an instance of Functor, replacing function
--- gmap with fmap.  Graph formulae are still not handled well:  the data types
--- will need re-working so that a "Formula lb" type constructor can be
--- introduced having the correct (* -> *) kind to be a Functor.
---
--- Revision 1.16  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.15  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.14  2003/05/23 19:33:36  graham
--- Added and tested RDF graph label translation functions
---
--- Revision 1.13  2003/05/14 19:38:32  graham
--- Simple formatter tests all working with reworked graph and lookup structures.
--- More complex formatter tests still to be coded.
---
--- Revision 1.12  2003/05/14 02:01:59  graham
--- GraphMatch recoded and almost working, but
--- there are a couple of
--- obscure bugs that are proving rather stubborn to squash.
---
--- Revision 1.11  2003/05/09 00:28:48  graham
--- Added partitionBy to ListHelpers (may want to remove since
--- it's also in the standard List module).
--- Added mapSelect and mapMerge to LookupMap, and test cases.
---
--- Revision 1.10  2003/05/07 23:58:09  graham
--- More restructuring.
--- RDFGraphTest runs OK.
--- N3ParserTest needs to be updated to use new structure for formulae.
---
--- Revision 1.9  2003/05/07 19:25:26  graham
--- Added mapFindMaybe to LookupMap export list
---
--- Revision 1.8  2003/05/07 18:50:38  graham
--- Add LookupMap functions: mapFindMaybe, mapKeys, mapEq
---
--- Revision 1.7  2003/05/01 23:15:44  graham
--- GraphTest passes all tests using refactored LookupMap
--- Extensive changes to GraphMatch were required.
---
--- Revision 1.6  2003/05/01 19:14:26  graham
--- LookupMap refactored to use class for entry, so that it can be
--- applied to a variety of different types with identifiable key and value
--- components.  All tests pass.
---
--- Revision 1.5  2003/05/01 00:21:41  graham
--- Started refactoring LookupMap.
--- Revised module compiles OK.
--- Working on test module.
---
--- Revision 1.4  2003/04/29 22:07:10  graham
--- Some refactoring of N3 formatter.
--- N3 formatter now handles trivial cases.
--- More complex formatter test cases still to be developed.
---
--- Revision 1.3  2003/04/24 23:41:39  graham
--- Added Ord class membership to graph nodes
--- Added empty lookup table definition
--- Started on N3 formatter module
---
--- Revision 1.2  2003/04/11 18:04:49  graham
--- Rename GraphLookupMap to LookupMap:
--- GraphTest runs OK.
---
--- Revision 1.1  2003/04/11 17:38:33  graham
--- Rename GraphLookupMap to LookupMap
---
− Swish/HaskellUtils/LookupMapTest.hs 
@@ -1,660 +0,0 @@-{-# OPTIONS -XFlexibleInstances #-}
-{-# OPTIONS -XMultiParamTypeClasses #-}
-
---------------------------------------------------------------------------------
---  $Id: LookupMapTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  LookupMapTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
--- This Module defines test cases for module Parse parsing functions.
---
---------------------------------------------------------------------------------
-
---   WNH RIP OUT module Swish.HaskellUtils.LookupMapTest where
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..), LookupMap(..)
-    , emptyLookupMap, makeLookupMap, listLookupMap
-    , reverseLookupMap
-    , keyOrder
-    , mapFind, mapFindMaybe, mapContains
-    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap
-    , mapAdd, mapAddIfNew
-    , mapDelete, mapDeleteAll
-    , mapApplyToAll, mapTranslate
-    , mapEq, mapKeys, mapVals
-    , mapSelect, mapMerge
-    , mapSortByKey, mapSortByVal
-    , mapTranslateKeys, mapTranslateVals
-    , mapTranslateEntries, mapTranslateEntriesM
-    )
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Data.List ( sort )
-
-import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertEqual, runTestTT, runTestText, putTextToHandle )
-
-------------------------------------------------------------
---  Declare lookup entry for testing
-------------------------------------------------------------
-
-data GenMapEntry a b = E a b
-
-instance (Eq a, Show a, Eq b, Show b)
-    => LookupEntryClass (GenMapEntry a b) a b
-    where
-        keyVal   (E k v) = (k,v)
-        newEntry (k,v)   = (E k v)
-
-instance (Eq a, Show a, Eq b, Show b) => Show (GenMapEntry a b) where
-    show = entryShow
-
-instance (Eq a, Show a, Eq b, Show b) => Eq (GenMapEntry a b) where
-    (==) = entryEq
-
-type TestEntry  = GenMapEntry Int String
-type TestMap    = LookupMap (GenMapEntry Int String)
-type RevTestMap = LookupMap (GenMapEntry String Int)
-type MayTestMap = Maybe RevTestMap
-type StrTestMap = LookupMap (GenMapEntry String String)
-
-------------------------------------------------------------
---  Test class helper
-------------------------------------------------------------
-
-testeq :: (Show a, Eq a) => String -> a -> a -> Test
-testeq lab req got =
-    TestCase ( assertEqual ("test"++lab) req got )
-
-testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test
-testeqv lab req got =
-    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )
-
-------------------------------------------------------------
---  LookupMap functions
-------------------------------------------------------------
-
-newMap :: [(Int,String)] -> TestMap
-newMap es = makeLookupMap (map newEntry es)
-
-testLookupMap :: String -> TestMap -> [(Int,String)] -> Test
-testLookupMap lab m1 m2 = testeq ("LookupMap"++lab ) (newMap m2) m1
-
-testLookupMapFind :: String -> TestMap -> Int -> String -> Test
-testLookupMapFind lab lm k res =
-    testeq ("LookupMapFind"++lab ) res (mapFind "" k lm)
-
-lm00 = newMap []
-testLookupMap00     = testLookupMap     "00" lm00 []
-testLookupMapFind00 = testLookupMapFind "00" lm00 2 ""
-
-lm01 = mapAdd lm00 $ newEntry (1,"aaa")
-testLookupMap01     = testLookupMap     "01" lm01 [(1,"aaa")]
-testLookupMapFind01 = testLookupMapFind "01" lm01 2 ""
-
-lm02 = mapAdd lm01 $ newEntry (2,"bbb")
-testLookupMap02     = testLookupMap     "02" lm02 [(2,"bbb"),(1,"aaa")]
-testLookupMapFind02 = testLookupMapFind "02" lm02 2 "bbb"
-
-lm03 = mapAdd lm02 $ newEntry (3,"ccc")
-testLookupMap03     = testLookupMap     "03" lm03 [(3,"ccc"),(2,"bbb"),(1,"aaa")]
-testLookupMapFind03 = testLookupMapFind "03" lm03 2 "bbb"
-
-lm04 = mapAdd lm03 $ newEntry (2,"bbb")
-testLookupMap04     = testLookupMap     "04" lm04 [(2,"bbb"),(3,"ccc"),(2,"bbb"),(1,"aaa")]
-testLookupMapFind04 = testLookupMapFind "04" lm04 2 "bbb"
-
-lm05 = mapReplaceAll lm04 $ newEntry (2,"bbb1")
-testLookupMap05     = testLookupMap     "05" lm05 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
-testLookupMapFind05 = testLookupMapFind "05" lm05 2 "bbb1"
-
-lm06 = mapReplaceAll lm05 $ newEntry (9,"zzzz")
-testLookupMap06     = testLookupMap     "06" lm06 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
-testLookupMapFind06 = testLookupMapFind "06" lm06 2 "bbb1"
-
-lm07 = mapReplace lm06 $ newEntry (2,"bbb")
-testLookupMap07     = testLookupMap     "07" lm07 [(2,"bbb"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
-testLookupMapFind07 = testLookupMapFind "07" lm07 2 "bbb"
-testLookupMapFind0x = testLookupMapFind "0x" lm07 9 ""
-
-lm08 = mapDelete lm07 3
-testLookupMap08     = testLookupMap     "08" lm08 [(2,"bbb"),(2,"bbb1"),(1,"aaa")]
-testLookupMapFind08 = testLookupMapFind "08" lm08 2 "bbb"
-
-lm09 = mapDeleteAll lm08 2
-testLookupMap09     = testLookupMap     "09" lm09 [(1,"aaa")]
-testLookupMapFind09 = testLookupMapFind "09" lm09 2 ""
-
-la10 = mapApplyToAll lm03 (flip replicate '*')
-testLookupMapApp10  = testeq "LookupMapApplyToAll10" ["***","**","*"] la10
-
-lt11 = mapTranslate lm03 la10 1 "****"
-testLookupMapTran11  = testeq "LookupMapTranslate11" "*"   lt11
-
-lt12 = mapTranslate lm03 la10 2 "****"
-testLookupMapTran12  = testeq "LookupMapTranslate12" "**"  lt12
-
-lt13 = mapTranslate lm03 la10 3 "****"
-testLookupMapTran13  = testeq "LookupMapTranslate13" "***" lt13
-
-lt14 = mapTranslate lm03 la10 4 "****"
-testLookupMapTran14  = testeq "LookupMapTranslate14" "****" lt14
-
-lm20 = mapReplaceMap lm05 $ newMap [(2,"bbb20"),(3,"ccc20")]
-testLookupMap20     = testLookupMap     "20" lm20 [(2,"bbb20"),(3,"ccc20"),(2,"bbb20"),(1,"aaa")]
-testLookupMapFind20 = testLookupMapFind "20" lm20 2 "bbb20"
-
-lm21 = mapReplaceMap lm05 $ newMap []
-testLookupMap21     = testLookupMap     "21" lm21 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
-testLookupMapFind21 = testLookupMapFind "21" lm21 2 "bbb1"
-
-lm22 = mapReplaceMap lm05 $ newMap [(9,"zzz22"),(1,"aaa22")]
-testLookupMap22     = testLookupMap     "22" lm22 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
-testLookupMapFind22 = testLookupMapFind "22" lm22 1 "aaa22"
-
-testLookupContains31 = testeq "LookupContains31" True  (mapContains lm22 2)
-testLookupContains32 = testeq "LookupContains32" False (mapContains lm22 9)
-
-lm33 = mapAddIfNew lm22 $ newEntry (1,"aaa33")
-testLookupMap33      = testLookupMap      "33" lm33 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
-testLookupMapFind33a = testLookupMapFind "33a" lm33 1 "aaa22"
-testLookupMapFind33b = testLookupMapFind "33b" lm33 4 ""
-
-lm34 = mapAddIfNew lm22 $ newEntry (4,"ddd34")
-testLookupMap34      = testLookupMap      "34" lm34 [(4,"ddd34"),(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
-testLookupMapFind34a = testLookupMapFind "34a" lm34 1 "aaa22"
-testLookupMapFind34b = testLookupMapFind "34b" lm34 4 "ddd34"
-
-lm35 = mapReplaceOrAdd (newEntry (1,"aaa35")) lm22
-testLookupMap35      = testLookupMap      "35" lm35 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa35")]
-testLookupMapFind35a = testLookupMapFind "35a" lm35 1 "aaa35"
-testLookupMapFind35b = testLookupMapFind "35b" lm35 4 ""
-
-lm36 = mapReplaceOrAdd (newEntry (4,"ddd36")) lm22
-testLookupMap36      = testLookupMap      "36" lm36 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22"),(4,"ddd36")]
-testLookupMapFind36a = testLookupMapFind "36a" lm36 1 "aaa22"
-testLookupMapFind36b = testLookupMapFind "36b" lm36 4 "ddd36"
-
-testLookupMapSuite = TestList
-    [
-    testLookupMap01, testLookupMapFind01,
-    testLookupMap02, testLookupMapFind02,
-    testLookupMap03, testLookupMapFind03,
-    testLookupMap04, testLookupMapFind04,
-    testLookupMap05, testLookupMapFind05,
-    testLookupMap06, testLookupMapFind06,
-    testLookupMap07, testLookupMapFind07, testLookupMapFind0x,
-    testLookupMap08, testLookupMapFind08,
-    testLookupMap09, testLookupMapFind09,
-    testLookupMapApp10,
-    testLookupMapTran11, testLookupMapTran12,
-    testLookupMapTran13, testLookupMapTran14,
-    testLookupMap20, testLookupMapFind20,
-    testLookupMap21, testLookupMapFind21,
-    testLookupMap22, testLookupMapFind22,
-    testLookupContains31,
-    testLookupContains32,
-    testLookupMap33, testLookupMapFind33a, testLookupMapFind33b,
-    testLookupMap34, testLookupMapFind34a, testLookupMapFind34b,
-    testLookupMap35, testLookupMapFind35a, testLookupMapFind35b,
-    testLookupMap36, testLookupMapFind36a, testLookupMapFind36b
-    ]
-
-------------------------------------------------------------
---  Reverse lookup map test tests
-------------------------------------------------------------
-
-revdef = -1 :: Int
-
-newRevMap :: [(String,Int)] -> RevTestMap
-newRevMap es = makeLookupMap (map newEntry es)
-
-testRevLookupMap :: String -> RevTestMap -> [(String,Int)] -> Test
-testRevLookupMap lab m1 m2 =
-    testeq ("RevLookupMap"++lab) (newRevMap m2) m1
-
-testRevLookupMapFind :: String -> RevTestMap -> String -> Int -> Test
-testRevLookupMapFind lab lm k res =
-    testeq ("RevLookupMapFind"++lab) res (mapFind revdef k lm)
-
-rlm00 :: RevTestMap
-rlm00 = reverseLookupMap lm00
-testRevLookupMap00     = testRevLookupMap     "00" rlm00 []
-testRevLookupMapFind00 = testRevLookupMapFind "00" rlm00 "" revdef
-
-rlm01 :: RevTestMap
-rlm01 = reverseLookupMap lm01
-testRevLookupMap01     = testRevLookupMap     "01" rlm01 [("aaa",1)]
-testRevLookupMapFind01 = testRevLookupMapFind "01" rlm01 "bbb" revdef
-
-rlm02 :: RevTestMap
-rlm02 = reverseLookupMap lm02
-testRevLookupMap02     = testRevLookupMap     "02" rlm02 [("bbb",2),("aaa",1)]
-testRevLookupMapFind02 = testRevLookupMapFind "02" rlm02 "bbb" 2
-
-rlm03 :: RevTestMap
-rlm03 = reverseLookupMap lm03
-testRevLookupMap03     = testRevLookupMap     "03" rlm03 [("ccc",3),("bbb",2),("aaa",1)]
-testRevLookupMapFind03 = testRevLookupMapFind "03" rlm03 "bbb" 2
-
-rlm04 :: RevTestMap
-rlm04 = reverseLookupMap lm04
-testRevLookupMap04     = testRevLookupMap     "04" rlm04 [("bbb",2),("ccc",3),("bbb",2),("aaa",1)]
-testRevLookupMapFind04 = testRevLookupMapFind "04" rlm04 "bbb" 2
-
-rlm05 :: RevTestMap
-rlm05 = reverseLookupMap lm05
-testRevLookupMap05     = testRevLookupMap     "05" rlm05 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]
-testRevLookupMapFind05 = testRevLookupMapFind "05" rlm05 "bbb1" 2
-
-rlm06 :: RevTestMap
-rlm06 = reverseLookupMap lm06
-testRevLookupMap06     = testRevLookupMap     "06" rlm06 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]
-testRevLookupMapFind06 = testRevLookupMapFind "06" rlm06 "bbb1" 2
-
-rlm07 :: RevTestMap
-rlm07 = reverseLookupMap lm07
-testRevLookupMap07     = testRevLookupMap     "07" rlm07 [("bbb",2),("ccc",3),("bbb1",2),("aaa",1)]
-testRevLookupMapFind07 = testRevLookupMapFind "07" rlm07 "bbb" 2
-testRevLookupMapFind0w = testRevLookupMapFind "07" rlm07 "bbb1" 2
-testRevLookupMapFind0x = testRevLookupMapFind "0x" rlm07 "*" revdef
-
-rlm08 :: RevTestMap
-rlm08 = reverseLookupMap lm08
-testRevLookupMap08     = testRevLookupMap     "08" rlm08 [("bbb",2),("bbb1",2),("aaa",1)]
-testRevLookupMapFind08 = testRevLookupMapFind "08" rlm08 "bbb" 2
-
-rlm09 :: RevTestMap
-rlm09 = reverseLookupMap lm09
-testRevLookupMap09     = testRevLookupMap     "09" rlm09 [("aaa",1)]
-testRevLookupMapFind09 = testRevLookupMapFind "09" rlm09 "" revdef
-
-testRevLookupMapSuite = TestList
-    [
-    testRevLookupMap01, testRevLookupMapFind01,
-    testRevLookupMap02, testRevLookupMapFind02,
-    testRevLookupMap03, testRevLookupMapFind03,
-    testRevLookupMap04, testRevLookupMapFind04,
-    testRevLookupMap05, testRevLookupMapFind05,
-    testRevLookupMap06, testRevLookupMapFind06,
-    testRevLookupMap07, testRevLookupMapFind07,
-                        testRevLookupMapFind0w,
-                        testRevLookupMapFind0x,
-    testRevLookupMap08, testRevLookupMapFind08,
-    testRevLookupMap09, testRevLookupMapFind09
-    ]
-
-------------------------------------------------------------
---  mapKeys
-------------------------------------------------------------
-
-testMapKeys :: String -> TestMap -> [Int] -> Test
-testMapKeys lab m1 mk =
-    testeq ("testMapKeys:"++lab) mk (sort $ mapKeys m1)
-
-testMapKeys00 = testMapKeys "00" lm00 []
-testMapKeys01 = testMapKeys "01" lm01 [1]
-testMapKeys02 = testMapKeys "02" lm02 [1,2]
-testMapKeys03 = testMapKeys "03" lm03 [1,2,3]
-testMapKeys04 = testMapKeys "04" lm04 [1,2,3]
-testMapKeys05 = testMapKeys "05" lm05 [1,2,3]
-testMapKeys06 = testMapKeys "06" lm06 [1,2,3]
-testMapKeys07 = testMapKeys "07" lm07 [1,2,3]
-testMapKeys08 = testMapKeys "08" lm08 [1,2]
-testMapKeys09 = testMapKeys "09" lm09 [1]
-
-testMapKeysSuite = TestList
-    [ testMapKeys00
-    , testMapKeys01
-    , testMapKeys02
-    , testMapKeys03
-    , testMapKeys04
-    , testMapKeys05
-    , testMapKeys06
-    , testMapKeys07
-    , testMapKeys08
-    , testMapKeys09
-    ]
-
-------------------------------------------------------------
---  mapVals
-------------------------------------------------------------
-
-testMapVals :: String -> TestMap -> [String] -> Test
-testMapVals lab m1 mv =
-    testeq ("MapVals:"++lab) mv (sort $ mapVals m1)
-
-testMapVals00 = testMapVals "00" lm00 []
-testMapVals01 = testMapVals "01" lm01 ["aaa"]
-testMapVals02 = testMapVals "02" lm02 ["aaa","bbb"]
-testMapVals03 = testMapVals "03" lm03 ["aaa","bbb","ccc"]
-testMapVals04 = testMapVals "04" lm04 ["aaa","bbb","ccc"]
-testMapVals05 = testMapVals "05" lm05 ["aaa","bbb1","ccc"]
-testMapVals06 = testMapVals "06" lm06 ["aaa","bbb1","ccc"]
-testMapVals07 = testMapVals "07" lm07 ["aaa","bbb","bbb1","ccc"]
-testMapVals08 = testMapVals "08" lm08 ["aaa","bbb","bbb1"]
-testMapVals09 = testMapVals "09" lm09 ["aaa"]
-
-testMapValsSuite = TestList
-    [ testMapVals00
-    , testMapVals01
-    , testMapVals02
-    , testMapVals03
-    , testMapVals04
-    , testMapVals05
-    , testMapVals06
-    , testMapVals07
-    , testMapVals08
-    , testMapVals09
-    ]
-
-------------------------------------------------------------
---  mapEq
-------------------------------------------------------------
-
-maplist =
-  [ ("lm00",lm00)
-  , ("lm01",lm01)
-  , ("lm02",lm02)
-  , ("lm03",lm03)
-  , ("lm04",lm04)
-  , ("lm05",lm05)
-  , ("lm06",lm06)
-  , ("lm07",lm07)
-  , ("lm08",lm08)
-  , ("lm09",lm09)
-  ]
-
-mapeqlist =
-  [ ("lm01","lm09")
-  , ("lm02","lm08")
-  , ("lm03","lm04")
-  , ("lm03","lm07")
-  , ("lm04","lm07")
-  , ("lm05","lm06")
-  ]
-
-testMapEq :: String -> Bool -> TestMap -> TestMap -> Test
-testMapEq lab eq m1 m2 =
-    testeq ("testMapEq:"++lab) eq (mapEq m1 m2)
-
-testMapEqSuite = TestList
-  [ testMapEq (testLab l1 l2) (testEq l1 l2) m1 m2
-      | (l1,m1) <- maplist , (l2,m2) <- maplist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)       ||
-            (l1,l2) `elem` mapeqlist ||
-            (l2,l1) `elem` mapeqlist
-
-------------------------------------------------------------
---  mapSelect and mapMerge
-------------------------------------------------------------
-
-lm101 = mapAdd lm03 $ newEntry (4,"ddd")
-testLookupMap101 = testLookupMap "101" lm101 [(4,"ddd"),(3,"ccc"),(2,"bbb"),(1,"aaa")]
-
-lm102 = mapSelect lm101 [1,3]
-testLookupMap102 = testLookupMap "102" lm102 [(3,"ccc"),(1,"aaa")]
-
-lm103 = mapSelect lm101 [2,4]
-testLookupMap103 = testLookupMap "103" lm103 [(4,"ddd"),(2,"bbb")]
-
-lm104 = mapSelect lm101 [2,3]
-testLookupMap104 = testLookupMap "104" lm104 [(3,"ccc"),(2,"bbb")]
-
-mapSelectSuite = TestList
-    [ testLookupMap101
-    , testLookupMap102
-    , testLookupMap103
-    , testLookupMap104
-    ]
-
-lm105 = mapMerge lm102 lm103
-testLookupMap105 = testLookupMap "105" lm105 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]
-
-lm106 = mapMerge lm102 lm104
-testLookupMap106 = testLookupMap "106" lm106 [(1,"aaa"),(2,"bbb"),(3,"ccc")]
-
-lm107 = mapMerge lm103 lm104
-testLookupMap107 = testLookupMap "107" lm107 [(2,"bbb"),(3,"ccc"),(4,"ddd")]
-
-lm108 = mapMerge lm101 lm102
-testLookupMap108 = testLookupMap "108" lm108 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]
-
-mapMergeSuite = TestList
-    [ testLookupMap105
-    , testLookupMap106
-    , testLookupMap107
-    , testLookupMap108
-    ]
-
-------------------------------------------------------------
---  Tranlation tests
-------------------------------------------------------------
-
--- Rather late in the day, generic versions of the testing functions used earlier
-type TestMapG a b = LookupMap (GenMapEntry a b)
-newMapG :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> (TestMapG a b)
-newMapG es = makeLookupMap (map newEntry es)
-testLookupMapG :: (Eq a, Show a, Eq b, Show b) => String -> (TestMapG a b) -> [(a,b)] -> Test
-testLookupMapG lab m1 m2 = testeq ("LookupMapG"++lab ) (newMapG m2) m1
-testLookupMapM ::
-    (Eq a, Show a, Eq b, Show b, Monad m,
-     Eq (m (TestMapG a b)), Show (m (TestMapG a b)))
-    => String -> m (TestMapG a b) -> m (TestMapG a b) -> Test
-testLookupMapM lab m1 m2 = testeq ("LookupMapM"++lab ) m2 m1
-
-tm101               = newMap [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]
-testTranslateMap101 = testLookupMapG "tm101" tm101 [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]
-
-tf102 = (flip replicate '*') :: Int -> String
-tm102 :: StrTestMap
-tm102 = mapTranslateKeys tf102 tm101
-testTranslateMap102 = testLookupMapG "tm102" tm102 [("*","a"),("**","bb"),("***","ccc"),("****","dddd")]
-
-tf103 = length
-tm103 :: RevTestMap
-tm103 = mapTranslateVals tf103 tm102
-testTranslateMap103 = testLookupMapG "tm103" tm103 [("*",1),("**",2),("***",3),("****",4)]
-
-tf104 e = newEntry ( (flip replicate '#') k, 5-(length v) ) where (k,v) = keyVal e
-tm104 :: RevTestMap
-tm104 = mapTranslateEntries tf104 tm101
-testTranslateMap104 = testLookupMapG "tm104" tm104 [("#",4),("##",3),("###",2),("####",1)]
-
--- Test monadic translation, using Maybe monad
--- (Note that if Nothing is generated at any step,
--- it propagates to the result)
-tf105 e = Just $ tf104 e
-tm105 :: MayTestMap
-tm105 = mapTranslateEntriesM tf105 tm101
-testTranslateMap105 = testLookupMapM "tm105" tm105 (Just tm104)
-
-tf106 e = if k == 2 then Nothing else tf105 e where (k,_) = keyVal e
-tm106 :: MayTestMap
-tm106 = mapTranslateEntriesM tf106 tm101
-testTranslateMap106 = testLookupMapM "tm106" tm106 Nothing
-
-mapTranslateSuite = TestList
-    [ testTranslateMap101
-    , testTranslateMap102
-    , testTranslateMap103
-    , testTranslateMap104
-    , testTranslateMap105
-    , testTranslateMap106
-    ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ testLookupMapSuite
-  , testRevLookupMapSuite
-  , testMapKeysSuite
-  , testMapValsSuite
-  , testMapEqSuite
-  , mapSelectSuite
-  , mapMergeSuite
-  , mapTranslateSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/LookupMapTest.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: LookupMapTest.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.20  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.19  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.18  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.17  2003/12/03 22:04:00  graham
--- Re-ordered mapFind (again), to simplify currying of default value.
---
--- Revision 1.16  2003/12/03 22:02:09  graham
--- Re-ordered mapFind, to simplify currying of default value.
---
--- Revision 1.15  2003/10/24 21:02:42  graham
--- Changed kind-structure of LookupMap type classes.
---
--- Revision 1.14  2003/10/14 20:31:21  graham
--- Add separate module for generic variable binding functions.
---
--- Revision 1.13  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.12  2003/06/11 14:07:53  graham
--- Added mapTranslateEntriesM, which performs monadic translation of
--- LookupMap entries.  (Tested using Maybe monad.)
---
--- Revision 1.11  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.10  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.9  2003/05/26 22:30:36  graham
--- Working on graph merge.
--- Added methods to Graph class for manipulating variable node.
--- Need to get RDFGraph to compile.  And test.
---
--- Revision 1.8  2003/05/23 19:33:36  graham
--- Added and tested RDF graph label translation functions
---
--- Revision 1.7  2003/05/09 00:28:48  graham
--- Added partitionBy to ListHelpers (may want to remove since
--- it's also in the standard List module).
--- Added mapSelect and mapMerge to LookupMap, and test cases.
---
--- Revision 1.6  2003/05/07 18:50:38  graham
--- Add LookupMap functions: mapFindMaybe, mapKeys, mapEq
---
--- Revision 1.5  2003/05/01 23:15:44  graham
--- GraphTest passes all tests using refactored LookupMap
--- Extensive changes to GraphMatch were required.
---
--- Revision 1.4  2003/05/01 19:14:26  graham
--- LookupMap refactored to use class for entry, so that it can be
--- applied to a variety of different types with identifiable key and value
--- components.  All tests pass.
---
--- Revision 1.3  2003/05/01 00:21:41  graham
--- Started refactoring LookupMap.
--- Revised module compiles OK.
--- Working on test module.
---
--- Revision 1.2  2003/04/11 18:12:10  graham
--- Renamed GraphHelpers to ListHelpers
--- LookupMapTest, GraphTest, RDFGraphTest all run OK
---
--- Revision 1.1  2003/04/11 18:05:57  graham
--- Add separate LookupMap test harness
--- Added mapReplaceOrAdd function
--- LookupMapTest runs OK
---
--- Revision 1.7  2003/04/10 13:41:22  graham
--- More graph code tidying
--- Graph test cases still run OK
---
--- Revision 1.6  2003/04/10 13:35:34  graham
--- Separated GraphMatch logic from GraphMem
---
--- Revision 1.5  2003/04/10 08:36:06  graham
--- Graph matching passes battery of new tests
--- Started work on RDF graph
---
--- Revision 1.4  2003/03/31 22:18:08  graham
--- Simple graph equality tests all pass
---
--- Revision 1.3  2003/03/31 20:52:23  graham
--- Restructure graph matching to deal with same unbound node names in
--- different graphs.  It shows signs that it might be working now.
--- More testing is needed.
---
--- Revision 1.2  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
--- Revision 1.1  2003/03/12 23:00:43  graham
--- Graph model coded and working, except for graph isomorphism test.
---
− Swish/HaskellUtils/MiscHelpers.hs 
@@ -1,137 +0,0 @@---------------------------------------------------------------------------------
---  $Id: MiscHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  MiscHelpers
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines some generic list and related helper functions
---  used by the graph handling code.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.MiscHelpers
-      ( assert, lower, stricmp, quote, hash, hashModulus )
-where
-
-import Data.Char
-    ( toLower )
-
-------------------------------------------------------------
---  assert test
-------------------------------------------------------------
-
-assert :: Bool -> String -> a -> a
-assert cond msg expr = if not cond then error msg else expr
-
-------------------------------------------------------------
---  Generate lowercase form of supplied string
-------------------------------------------------------------
-
-lower (c:st)   = (toLower c):(lower st)
-lower []       = ""
-
-------------------------------------------------------------
---  Case insensitive compare.
-------------------------------------------------------------
---
---  Should be used only for values using just the US ASCII
---  character set.  Use with richer character sets can yield
---  surprising results.
-
-stricmp :: String -> String -> Bool
-stricmp (c1:s1) (c2:s2) = (toLower c1) == (toLower c2) && (stricmp s1 s2)
-stricmp []      []      = True
-stricmp _       _       = False
-
-------------------------------------------------------------
---  Generate quoted form of supplied string:
-------------------------------------------------------------
---
---  [[[TODO: The list of quoting options here is incomplete]]]
-
-quote  st = ['"'] ++ (quote1 st) ++ ['"']
-quote1 ('"': st)    = '\\':'"' :(quote1 st)
-quote1 ('\\':st)    = '\\':'\\':(quote1 st)
-quote1 ('\n':st)    = '\\':'n':(quote1 st)
-quote1 ('\r':st)    = '\\':'r':(quote1 st)
-quote1 (c:st)       = c:(quote1 st)
-quote1 []           = ""
-
-------------------------------------------------------------
---  Hash function and values
-------------------------------------------------------------
---
---  Simple hash function based on Sedgewick, Algorithms in C, p 233
---  (choose mx*cm+255 < maxBound)
---  'seed' is an additional parameter that allows the function
---  to be varied for re-hashing.
-
-hashModulus = 16000001::Int
-
-hash :: Int -> String -> Int
-hash seed str = hash1 seed (64+seed) hashModulus str
-
-hash1 :: Int -> Int -> Int -> String -> Int
-hash1 sofar cm mx (c:str) = hash1 (( (sofar*cm) + (fromEnum c) ) `rem` mx) cm mx str
-hash1 sofar _ _ []        = sofar
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/MiscHelpers.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: MiscHelpers.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.6  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.5  2004/01/07 14:29:15  graham
--- Move stricmp to MiscHelpers
---
--- Revision 1.4  2003/12/04 02:53:27  graham
--- More changes to LookupMap functions.
--- SwishScript logic part complete, type-checks OK.
---
--- Revision 1.3  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.2  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.1  2003/05/20 17:29:44  graham
--- Split original helper functions module into ListHelpers and MiscHelpers
---
− Swish/HaskellUtils/Namespace.hs 
@@ -1,244 +0,0 @@-{-# OPTIONS -XTypeSynonymInstances #-}-{-# OPTIONS -XMultiParamTypeClasses #-}---------------------------------------------------------------------------------
---  $Id: Namespace.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Namespace
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines algebraic datatypes for namespaces and scoped names.
---
---  For these purposes, a namespace is a prefix and URI used to identify
---  a namespace (cf. XML namespaces), and a scoped name is a name that
---  is scoped by a specified namespace.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.Namespace
-    ( Namespace(..)
-    , makeNamespaceQName
-    , nullNamespace
-    , ScopedName(..)
-    , getScopePrefix, getScopeURI
-    , getQName, getScopedNameURI
-    , matchName
-    , makeScopedName, makeQNameScopedName, makeUriScopedName
-    , nullScopedName
-    )
-where
-
-import Swish.HaskellUtils.QName
-    ( QName(..), getQNameURI )
-
-import Swish.HaskellUtils.LookupMap
-    ( LookupEntryClass(..) )
-
-{- in Prelude???-import Maybe
-    ( Maybe(..), fromJust )
--}-
-------------------------------------------------------------
---  Namespace, having a prefix and a URI
-------------------------------------------------------------
-
--- |A NameSpace value consists of a prefix and a corresponding URI.
---  The prefix may be Nothing, in which case it is assumed to be inknown.
---
-data Namespace = Namespace { nsPrefix :: String, nsURI :: String }
-
-{-
-getNamespacePrefix :: Namespace -> String
-getNamespacePrefix = nsPrefix
-
-getNamespaceURI    :: Namespace -> String
-getNamespaceURI    = nsURI
--}
-
-instance Eq Namespace where
-    (==) = nsEq
-
-instance Show Namespace where
-    show (Namespace p u) =
-        (if p == "?" then "" else p ++ ":") ++ "<" ++ u ++ ">"
-
-instance LookupEntryClass Namespace String String where
-    keyVal   (Namespace pre uri) = (pre,uri)
-    newEntry (pre,uri)           = (Namespace pre uri)
-
-nsEq :: Namespace -> Namespace -> Bool
-nsEq (Namespace _ u1) (Namespace _ u2) = u1 == u2
-
-makeNamespaceQName :: Namespace -> String -> QName
-makeNamespaceQName ns loc = QName (nsURI ns) loc
-
-nullNamespace :: Namespace
-nullNamespace = Namespace "?" ""
-
-------------------------------------------------------------
---  ScopedName, made from a namespace and a local name
-------------------------------------------------------------
-
--- |A full ScopedName value has a QName prefix, namespace URI
---  and a local part.  ScopedName values may omit the prefix
---  (see Namespace) or the local part.
---
---  Some applications may handle null namespace URIs as meaning
---  the local part is relative to some base URI.
---
-data ScopedName = ScopedName { snScope :: Namespace, snLocal :: String }
-
-getScopePrefix :: ScopedName -> String
-getScopePrefix = nsPrefix . snScope
-
-getScopeURI :: ScopedName -> String
-getScopeURI = nsURI . snScope
-
-instance Eq ScopedName where
-    (==) = snEq
-
-instance Ord ScopedName where
-    (<=) = snLe
-
-instance Show ScopedName where
-    show (ScopedName n l) =
-        if pre == "?" then "<"++uri++l++">" else pre++":"++l
-        where
-            pre = nsPrefix n
-            uri = nsURI n
-
---  Scoped names are equal of ther corresponding QNames are equal
-snEq :: ScopedName -> ScopedName -> Bool
-snEq s1 s2 = (getQName s1) == (getQName s2)
-
---  Scoped names are ordered by their QNames
-snLe :: ScopedName -> ScopedName -> Bool
-snLe s1 s2 = (getQName s1) <= (getQName s2)
-
--- |Get QName corresponding to a scoped name
-getQName :: ScopedName -> QName
-getQName n = QName (getScopeURI n) (snLocal n)
-
--- |Get URI corresponding to a scoped name (using RDF conventions)
-getScopedNameURI :: ScopedName -> String
-getScopedNameURI = getQNameURI . getQName
-
--- |Test if supplied string matches the display form of a
---  scoped name.
-matchName :: String -> ScopedName -> Bool
-matchName str nam = str == show nam
-
--- |Construct a ScopedName from prefix, URI and local name
-makeScopedName :: String -> String -> String -> ScopedName
-makeScopedName pre nsuri loc =
-    ScopedName (Namespace pre nsuri) loc
-
--- |Construct a ScopedName from a QName
-makeQNameScopedName :: QName -> ScopedName
-makeQNameScopedName (QName u l) = makeScopedName "?" u l
-
--- |Construct a ScopedName for a bare URI
-makeUriScopedName :: String -> ScopedName
-makeUriScopedName u = makeScopedName "?" u ""
-
--- |Null scoped name:  this should never appear as a valid name
-nullScopedName :: ScopedName
-nullScopedName = makeScopedName "?" "" ""
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/Namespace.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: Namespace.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.13  2004/01/07 19:49:12  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.12  2003/12/08 23:55:36  graham
--- Various enhancements to variable bindings and proof structure.
--- New module BuiltInMap coded and tested.
--- Script processor is yet to be completed.
---
--- Revision 1.11  2003/12/03 17:07:24  graham
--- Replace occurrences of QName in N3Parser with ScopedName.
---
--- Revision 1.10  2003/11/24 17:20:34  graham
--- Separate module Vocabulary from module Namespace.
---
--- Revision 1.9  2003/11/24 15:46:03  graham
--- Rationalize N3Parser and N3Formatter to use revised vocabulary
--- terms defined in Namespace.hs
---
--- Revision 1.8  2003/11/14 21:48:35  graham
--- First cut cardinality-checked datatype-constraint rules to pass test cases.
--- Backward chaining is still to do.
---
--- Revision 1.7  2003/11/13 01:13:47  graham
--- Reworked ruleset to use ScopedName lookup.
--- Various minor fixes.
---
--- Revision 1.6  2003/11/12 20:44:24  graham
--- Added some vocabulary to Namespace.
--- Enhaced ScopedName to allow null namespace prefixes,
--- following N3 display conventions.
---
--- Revision 1.5  2003/10/24 21:05:08  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.4  2003/10/22 16:18:37  graham
--- Move common namespace definitions into Namespace module
--- (May later move these into separate modules.)
---
--- Revision 1.3  2003/10/02 13:41:26  graham
--- Supporting changes for RDF axioms and rules defined as Rulesets,
--- and moved out of module RDFProofCheck.
--- Datatype named using ScopedName rather than QName
--- (Datatype framework is still work in progress).
---
--- Revision 1.2  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.1  2003/09/24 18:51:36  graham
--- Add module Namespace and test cases.
---
--- Revision 1.1  2003/09/24 12:51:00  graham
--- Add separate QName module and test suite
---
− Swish/HaskellUtils/Network/URI.hs 
@@ -1,754 +0,0 @@---------------------------------------------------------------------------------
---  $Id: URI.hs,v 1.2 2004/02/02 14:00:39 graham Exp $
---
---  Copyright (c) 2004, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Network.URI
---  Copyright   :  (c) 2004, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---
---  This module defines functions for handling URIs.  It presents the same
---  interface as the GHC Network.URI module, but is implemented using Parsec
---  rather than a Regex library that is not available with Hugs.
---
---  In addition, four methods are provided for classifying different
---  kinds of URI string (as noted in RFC2396bis):
---      isURI
---      isURIReference
---      isRelativeURI
---      isAbsoluteURI
---
---  The current official reference for URI handling is RFC2396 [1],
---  as updated by RFC 2732 [2].
---
---  These are being merged into RFC2396bis [3], a work-in-progress copy of
---  which is available at the URI indicated.  This document has been used
---  as the primary reference for constructing the URI parser implemented
---  here, and it is intended that there is a direct relationship between
---  the syntax definition in that document and the parser implementation.
---
---  [1] http://www.ietf.org/rfc/rfc2396.txt
---  [2] http://www.ietf.org/rfc/rfc2732.txt
---  [3] http://gbiv.com/protocols/uri/rev-2002/rfc2396bis.html
---      (This implementation based on a version dated Sep-2003,
---      also available as CVS revision 1.64 from
---      http://cvs.apache.org/viewcvs.cgi/ietf-uri/rev-2002/)
---
---  Some of the code has been copied from the GHC implementation, but
---  the parser is replaced with one that performs more complete
---  syntax checking of the URI itself, according to RFC2396bis [3].
---
---------------------------------------------------------------------------------
-
-module {-Network.-} Swish.HaskellUtils.Network.URI
-    ( -- * The @URI@ type
-      URI(..)
-      -- * Parsing a @URI@
-    , parseURI                  -- :: String -> Maybe URI
-      -- * Testing URI categories
-    , isURI, isURIReference, isRelativeURI, isAbsoluteURI
-    , isIPv6address, isIPv4address
-    , testURIReference
-      -- * Computing relative @URI@s
-    , relativeTo                -- :: URI -> URI -> Maybe URI
-      -- * Operations on @URI@ strings
-      -- | support for putting strings into URI-friendly
-      -- escaped format and getting them back again.
-      -- This can't be done transparently, because certain characters
-      -- have different meanings in different kinds of URI.
-    , reserved, unreserved
-    , isAllowedInURI, unescapedInURI    -- :: Char -> Bool
-    , escapeChar                -- :: (Char->Bool) -> Char -> String
-    , escapeString              -- :: String -> (Char->Bool) -> String
-    , unEscapeString            -- :: String -> String
-    )
-where
-
-import Numeric( showIntAtBase )
-
-import Data.Char( ord, chr, isHexDigit, isSpace )
-
-{- in Prelude???-import Text.Parsec
-    ( GenParser(..), ParseError(..)
-    , parse, (<|>), (<?>), try
-    , option, many, count, notFollowedBy, lookAhead
-    , char, satisfy, oneOf, string, letter, digit, hexDigit, eof
-    )
--}-import Text.ParserCombinators.Parsec-
-------------------------------------------------------------
---  The URI datatype
-------------------------------------------------------------
-
--- |Represents a general universal resource identifier using
---  its component parts.
---
---  For example, for the URI
---
---  >   http://www.haskell.org/ghc?query#frag
---
---  the components are:
---
-data URI = URI
-    { scheme    :: String   -- ^ @http@
-    , authority :: String   -- ^ @www.haskell.org@
-    , path      :: String   -- ^ @\/ghc@
-    , query     :: String   -- ^ @query@
-    , fragment  :: String   -- ^ @frag@
-    }
-
-instance Show URI where
-    showsPrec _ uri = uriToString uri
-
-------------------------------------------------------------
---  Parse a URI
-------------------------------------------------------------
-
--- |Turn a string into a @URI@.
---  Returns @Nothing@ if the string is not a valid URI.
---
-parseURI :: String -> Maybe URI
-parseURI uristr = case parseAll uriReference "" uristr of
-        Left  _ -> Nothing
-        Right u -> Just u
-
-isURI :: String -> Bool
-isURI = isValidParse uri
-
-isURIReference :: String -> Bool
-isURIReference = isValidParse uriReference
-
-isRelativeURI :: String -> Bool
-isRelativeURI = isValidParse relativeUri
-
-isAbsoluteURI :: String -> Bool
-isAbsoluteURI = isValidParse absoluteUri
-
-isIPv6address :: String -> Bool
-isIPv6address = isValidParse ipv6address
-
-isIPv4address :: String -> Bool
-isIPv4address = isValidParse ipv4address
-
-isValidParse :: UriParser a -> String -> Bool
-isValidParse parser uristr = case parseAll parser "" uristr of
-        -- Left  e -> error (show e)
-        Left  _ -> False
-        Right u -> True
-
-testURIReference :: String -> String
-testURIReference uristr = show (parseAll uriReference "" uristr)
-
-parseAll :: UriParser a -> String -> String -> Either ParseError a
-parseAll parser filename uristr = parse newparser filename uristr
-    where
-        newparser =
-            do  { res <- parser
-                ; eof
-                ; return res
-                }
-
-------------------------------------------------------------
---  URI parser body based on Parsec elements and combinators
-------------------------------------------------------------
-
---  Parser parser type.
---  Currently
-type UriParser a = GenParser Char () a
-
---  Relative and absolute forms
---
---  (Note, per RFC2396bis, fragment id is part of the full URI form)
---
---  RFC2396bis, section 4.1
-
-uriReference :: UriParser URI
-uriReference = uri <|> relativeUri
-
---  RFC2396bis, section 4.2
-
-relativeUri :: UriParser URI
-relativeUri =
-    do  { (ua,up) <- hierPart
-        ; uq <- option "" ( do { string "?" ; uquery    } )
-        ; uf <- option "" ( do { string "#" ; ufragment } )
-        ; return $ URI
-            { scheme    = ""
-            , authority = ua
-            , path      = up
-            , query     = uq
-            , fragment  = uf
-            }
-        }
-
---  RFC2396bis, section 4.3
-
-absoluteUri :: UriParser URI
-absoluteUri =
-    do  { us <- uscheme
-        ; (ua,up) <- hierPart
-        ; uq <- option "" ( do { string "?" ; uquery    } )
-        ; return $ URI
-            { scheme    = us
-            , authority = ua
-            , path      = up
-            , query     = uq
-            , fragment  = ""
-            }
-        }
-
---  RFC2396bis, section 3
-
-uri :: UriParser URI
-uri =
-    do  { us <- try uscheme
-        ; (ua,up) <- hierPart
-        ; uq <- option "" ( do { string "?" ; uquery    } )
-        ; uf <- option "" ( do { string "#" ; ufragment } )
-        ; return $ URI
-            { scheme    = us
-            , authority = ua
-            , path      = up
-            , query     = uq
-            , fragment  = uf
-            }
-        }
-
-hierPart :: UriParser (String,String)
-hierPart = netPath <|> absPath <|> relPath
-
-netPath :: UriParser (String,String)
-netPath =
-    do  { try (string "//")
-        ; ua <- uauthority
-        ; (_,up) <- option ("","") absPath
-        ; return (ua,up)
-        }
-
-absPath :: UriParser (String,String)
-absPath =
-    do  { char '/'
-        ; up <- pathSegments
-        ; return ("",'/':up)
-        }
-
-relPath :: UriParser (String,String)
-relPath =
-        do  { try uscheme               -- RFC2356bis, section 4.1
-            ; fail "Scheme name in relative path"
-            }
-    <|>
-        do  { up <- pathSegments
-            ; return ("",up)
-            }
-
---  RFC2396bis, section 3.1
-
-uscheme :: UriParser String
-uscheme =
-    do  { s <- oneThenMany uriAlphaChar (alphanum <|> oneOf "+-.")
-        ; char ':'
-        ; return s
-        }
-
---  RFC2396bis, section 3.2
-
-uauthority :: UriParser String
-uauthority =
-    do  { uu <- option "" (try userinfo)
-        ; uh <- option "" host
-        ; up <- option "" port
-        ; return $ uu++uh++up
-        }
-
-userinfo :: UriParser String
-userinfo =
-    do  { uu <- many (uchar ";:&=+$,")
-        ; char '@'
-        ; return (concat uu ++"@")
-        }
-
-host :: UriParser String
-host = ipv6reference <|> try ipv4address <|> hostname
-
-ipv6reference :: UriParser String
-ipv6reference =
-    do  { char '['
-        ; ua <- ipv6address
-        ; char ']'
-        ; return $ "[" ++ ua ++ "]"
-        }
-
-ipv6address :: UriParser String
-ipv6address =
-        try ( do
-                { a2 <- count 6 h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ concat a2 ++ a3
-                } )
-    <|> try ( do
-                { string "::"
-                ; a2 <- count 5 h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ "::" ++ concat a2 ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 0
-                ; string "::"
-                ; a2 <- count 4 h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ concat a2 ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 1
-                ; string "::"
-                ; a2 <- count 3 h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ concat a2 ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 2
-                ; string "::"
-                ; a2 <- count 2 h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ concat a2 ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 3
-                ; string "::"
-                ; a2 <- h4c
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ a2 ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 4
-                ; string "::"
-                ; a3 <- ls32
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 5
-                ; string "::"
-                ; a3 <- h4
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::" ++ a3
-                } )
-    <|> try ( do
-                { a1 <- opt_n_h4c_h4 6
-                ; string "::"
-                -- ; lookAhead $ char ']'
-                ; return $ a1 ++ "::"
-                } )
-    <?> "IPv6 address"
-
-opt_n_h4c_h4 :: Int -> UriParser String
-opt_n_h4c_h4 n = option "" $
-    do  { a1 <- countMinMax 0 n h4c
-        ; a2 <- h4
-        ; return $ concat a1 ++ a2
-        }
-
-ls32 :: UriParser String
-ls32 =  try ( do
-                { a1 <- h4c
-                ; a2 <- h4
-                ; return (a1++a2)
-                } )
-    <|> ipv4address
-
-h4c :: UriParser String
-h4c = try $
-    do  { a1 <- h4
-        ; char ':'
-        ; notFollowedBy (char ':')
-        ; return $ a1 ++ ":"
-        }
-
-h4 :: UriParser String
-h4 = countMinMax 1 4 uriHexDigitChar
-
-ipv4address :: UriParser String
-ipv4address =
-    do  { a1 <- decOctet ; char '.'
-        ; a2 <- decOctet ; char '.'
-        ; a3 <- decOctet ; char '.'
-        ; a4 <- decOctet
-        ; return $ a1++"."++a2++"."++a3++"."++a4
-        }
-
-decOctet :: UriParser String
-decOctet =
-    do  { a1 <- countMinMax 1 3 uriDigitChar
-        ; if read a1 > 255 then
-            fail "Decimal octet value too large"
-          else
-            return a1
-        }
-
-hostname :: UriParser String
-hostname =
-    do  { a1 <- domainlabel
-        ; a2 <- dqualified
-        ; return $ a1 ++ a2
-        }
-
-dqualified :: UriParser String
-dqualified =
-    do  { a1 <- many $ try (
-            do  { char '.'
-                ; a2 <- domainlabel
-                ; return ('.':a2)
-                } )
-        ; a3 <- option "" (string ".")
-        ; return $ concat a1 ++ a3
-        }
-
-domainlabel :: UriParser String
-domainlabel =
-    do  { a1 <- alphanum
-        ; a2 <- countMinMax 0 62 (alphanum <|> char '-')
-        ; if (not $ null a2) && (last a2 == '-') then
-            fail "Domain label ends with '-'"
-          else
-            return $ a1:a2
-        }
-    <?> "Domain label"
-
-alphanum :: UriParser Char
-alphanum = uriAlphaChar <|> uriDigitChar
-
-port :: UriParser String
-port =
-    do  { char ':'
-        ; p <- many uriDigitChar
-        ; return (':':p)
-        }
-
---  RFC2396bis, section 3.3
-
-pathSegments :: UriParser String
-pathSegments =
-    do  { s1 <- segment
-        ; s2 <- many $
-            do  { char '/'
-                ; s3 <- segment
-                ; return ('/':s3)
-                }
-        ; return $ s1 ++ concat s2
-        }
-
-segment :: UriParser String
-segment =
-    do  { ps <- many pchar
-        ; return $ concat ps
-        }
-
-pchar :: UriParser String
-pchar = uchar ";:@&=+$,"
-
--- helper function for pchar and friends
-uchar :: String -> UriParser String
-uchar extras =
-        do { c <- satisfy unreserved ; return [c] }
-    <|> escaped
-    <|> do { c <- oneOf extras ; return [c] }
-
-
---  RFC2396bis, section 3.4
-
-uquery :: UriParser String
-uquery =
-    do  { ss <- many $ uchar (";:@&=+$,"++"/?")
-        ; return $ concat ss
-        }
-
---  RFC2396bis, section 3.5
-
-ufragment :: UriParser String
-ufragment =
-    do  { ss <- many $ uchar (";:@&=+$,"++"/?")
-        ; return $ concat ss
-        }
-
---  RFC2396bis, section 2.4.1
-
-escaped :: UriParser String
-escaped =
-    do  { char '%'
-        ; h1 <- uriHexDigitChar
-        ; h2 <- uriHexDigitChar
-        ; return $ ['%',h1,h2]
-        }
-
---  Imports from RFC 2234
-
-uriAlphaChar :: UriParser Char
-uriAlphaChar = letter
-
-uriDigitChar :: UriParser Char
-uriDigitChar = digit
-
-uriHexDigitChar :: UriParser Char
-uriHexDigitChar = hexDigit
-
---  Additional parser combinators for common patterns
-
-oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a]
-oneThenMany p1 pr =
-    do  { a1 <- p1
-        ; ar <- many pr
-        ; return (a1:ar)
-        }
-
-countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
-countMinMax m n p | m > 0 =
-    do  { a1 <- p
-        ; ar <- countMinMax (m-1) (n-1) p
-        ; return (a1:ar)
-        }
-countMinMax _ n _ | n <= 0 = return []
-countMinMax _ n p = option [] $
-    do  { a1 <- p
-        ; ar <- countMinMax 0 (n-1) p
-        ; return (a1:ar)
-        }
-
-------------------------------------------------------------
---  Reconstruct a URI string
-------------------------------------------------------------
---
---  Turn a URI into a string.
---
---  Algorithm from part 7, sec 5.2, RFC 2396
---
-uriToString :: URI -> ShowS
-uriToString URI { scheme=scheme
-                , authority=authority
-                , path=path
-                , query=query
-                , fragment=fragment
-                } =
-    append  ":"  scheme    .
-    prepend "//" authority .
-    append  ""   path      .
-    prepend "?"  query     .
-    prepend "#"  fragment
-    where
-        prepend pre  "" rest = rest
-        prepend pre  s  rest = pre ++ s ++ rest
-        append  post "" rest = rest
-        append  post s  rest = s ++ post ++ rest
-
-------------------------------------------------------------
---  Character classes
-------------------------------------------------------------
-
--- |Returns 'True' if the character is a \"reserved\" character in a
---  URI.  To include a literal instance of one of these characters in a
---  component of a URI, it must be escaped.
---
---  RDF2396bis: section 2.2
---
-reserved :: Char -> Bool
-reserved c = c `elem` "/?#[];:@&=+$,"
-
--- |Returns 'True' if the character is an \"unreserved\" character in
---  a URI.  These characters do not need to be escaped in a URI.  The
---  only characters allowed in a URI are either 'reserved',
---  'unreserved', or an escape sequence (@%@ followed by two hex digits).
---
---  RDF2396bis: section 2.3
---
-unreserved :: Char -> Bool
-unreserved c = (c >= 'A' && c <= 'Z')
-        || (c >= 'a' && c <= 'z')
-        || (c >= '0' && c <= '9')
-        || mark c
-    -- NOTE: can't use isAlphaNum etc. because these deal with ISO 8859
-    -- (and possibly Unicode!) chars.
-    -- [[[Above was a comment originally in GHC Network/URI.hs:
-    --    when IRIs are introduced then most codepoints above 128(?) should
-    --    be treated as unreserved, and higher codepoints for letters should
-    --    certainly be allowed.
-    -- ]]]
-
--- |Returns 'True' if the character is a \"mark\" character.
---
---  RDF2396bis: section 2.3
---
-mark :: Char -> Bool
-mark c = c `elem` "-_.!~*'()"
-
--- | Returns 'True' if the character is allowed in a URI.
---
-isAllowedInURI :: Char -> Bool
-isAllowedInURI c = reserved c || unreserved c || c == '%' -- escape char
-
--- | Returns 'True' if the character is allowed unescaped in a URI.
---
-unescapedInURI :: Char -> Bool
-unescapedInURI c = reserved c || unreserved c
-
-------------------------------------------------------------
---  Escape sequence handling
-------------------------------------------------------------
-
--- |Escape character if supplied predicate is not satisfied,
---  otherwise return character as singleton string.
---
-escapeChar :: (Char->Bool) -> Char -> String
-escapeChar p c
-    | p c       = [c]
-    | otherwise = '%' : myShowHex (ord c) ""
-    where
-        myShowHex :: Int -> ShowS
-        myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
-            []  -> "00"
-            [c] -> ['0',c]
-            cs  -> cs
-        toChrHex d
-            | d < 10    = chr (ord '0' + fromIntegral d)
-            | otherwise = chr (ord 'A' + fromIntegral (d - 10))
-
--- |Can be used to make a string valid for use in a URI.
---
-escapeString
-    :: String           -- ^ the string to process
-    -> (Char->Bool)     -- ^ a predicate which returns 'False'
-                        --   if the character should be escaped
-    -> String           -- the resulting URI string
-escapeString s p = concatMap (escapeChar p) s
-
--- |Turns all instances of escaped characters in the string back
---  into literal characters.
-unEscapeString :: String -> String
-unEscapeString [] = ""
-unEscapeString ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =
-    chr (hexDigit x1 * 16 + hexDigit x2) : unEscapeString s
-    where
-        hexDigit c
-            | c >= 'A' && c <= 'F' = ord c - ord 'A' + 10
-            | c >= 'a' && c <= 'f' = ord c - ord 'a' + 10
-            | otherwise            = ord c - ord '0'
-unEscapeString (c:s) = c : unEscapeString s
-
-------------------------------------------------------------
--- Resolving a relative URI relative to a base URI
-------------------------------------------------------------
-
--- |Returns a new @URI@ which represents the value of the
---  first @URI@ interpreted as relative to the second @URI@.
---  For example:
---
---  > "foo" `relativeTo` "http://bar.org/" = "http://bar.org/foo"
---
---  Algorithm from sec 5.2, RFC 2396
---
-relativeTo :: URI -> URI -> Maybe URI
-ref `relativeTo` base =
-  -- ref has a scheme name, use it in its entirety.  Otherwise inherit
-  -- the scheme name from base.
-  if ref_scheme    /= ""  then Just ref else
-
-  -- ref has an authority - we're done.  Otherwise inherit the authority.
-  if ref_authority /= ""  then Just ref{scheme = base_scheme} else
-
-  -- ref has an absolute path, we're done.
-  if not (null ref_path) && head ref_path == '/'
-        then Just ref{scheme = base_scheme,
-                      authority = base_authority} else
-
-  -- relative path...
-  let new_path = munge (dropLastComponent base_path ++ ref_path) []
-  in if isErrorPath new_path
-        then Nothing
-        else Just ref{scheme = base_scheme,
-                      authority = base_authority,
-                      path = new_path}
-  where
-        URI{
-          scheme    = ref_scheme,
-          authority = ref_authority,
-          path      = ref_path,
-          query     = _ref_query,
-          fragment  = _ref_fragment
-         } = ref
-
-        URI{
-          scheme    = base_scheme,
-          authority = base_authority,
-          path      = base_path,
-          query     = _base_query,
-          fragment  = _base_fragment
-         } = base
-
-        munge [] [] = ""
-        munge [] ps = concat (reverse ps)
-        munge ('.':'/':s)     ps     = munge s ps
-        munge ['.']           ps     = munge [] ps
-        munge ('.':'.':'/':s) (p:ps) | p /= "/" = munge s ps
-        munge ['.','.']       (p:ps) = munge [] ps
-        munge s               ps     = munge rest' (p':ps)
-                where (p,rest) = break (=='/') s
-                      (p',rest') = case rest of
-                                        '/':r -> (p++"/",r)
-                                        r     -> (p,r)
-
-        dropLastComponent = reverse . dropWhile (/= '/') . reverse
-
-        isErrorPath ('/':'.':'.':'/':_) = True
-        isErrorPath _ = False
-
-stripLeadingWS, stripTrailingWS, stripWS :: String -> String
-stripLeadingWS  = dropWhile isSpace
-stripTrailingWS = reverse . stripLeadingWS . reverse
-stripWS         = stripLeadingWS . stripTrailingWS
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2004, G. KLYNE.  All rights reserved.
---
---  This 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 this software; if not, write to:
---    The Free Software Foundation, Inc.,
---    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/Network/URI.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: URI.hs,v $
--- Revision 1.2  2004/02/02 14:00:39  graham
--- Fix optional host name in URI.  Add test cases.
---
--- Revision 1.1  2004/01/27 21:13:45  graham
--- New URI module and test suite added,
--- implementing the GHC Network.URI interface.
---
---
− Swish/HaskellUtils/Parse.hs 
@@ -1,249 +0,0 @@---------------------------------------------------------------------------------
---  $Id: Parse.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  Parse
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This Module defines a collection of parsing functions.
---
---  The approach used is based on that in Simon Thompson's book
---  The Craft of Functional Programming, pages 354 et seq.
---
---  The function type for a parser is given by Parser a b (see below)
---  where a is the type of token to be parsed (e.g. Char), and the
---  result is a list of pairs (b,[a]), each corresponding to possible parse,
---  where the first memeber of the pair is the value parsed, and the
---  second is the remaining input sequence following the parsed value.
---
---  A successful parse will generally return a list of one, and an
---  unsuccessful parse returns an empty list.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.Parse
-      ( module Swish.HaskellUtils.Parse, isSpace, isAlpha, isDigit, isAlphaNum, isHexDigit )
-where
-
-import Data.Char
-      ( isSpace, isAlpha, isDigit, isAlphaNum, isHexDigit )
-
-type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
-
-alpha :: String-alpha    = ['a'..'z']++['A'..'Z']
--digit :: String-digit    = ['0'..'9']
--alphanum :: String-alphanum = alpha++digit
--hexdigit :: String-hexdigit = digit++['a'..'f']++['A'..'F']
-
-isOneOf :: Eq a => [a] -> a -> Bool
-isOneOf s c = c `elem` s
-
--- Assemble alternative parses
-parseAlt :: Parser a b -> Parser a b -> Parser a b
-parseAlt p1 p2 input = p1 input ++ p2 input
-
-
--- Select one of two parses, prefering the first.
-parseOne :: Parser a b -> Parser a b -> Parser a b
-parseOne p1 p2 input
-    | not (null first) = first
-    | otherwise        = p2 input
-    where first = p1 input
-
--- Parse optional item returning single list, or empty list if absent
-parseOptional :: Parser a [b] -> Parser a [b]
-parseOptional p1 = parseOne p1 ( parseReturn [] )
-
--- Parse sequence of values, returning list of pairs
-infixr 5 >*>
-(>*>) :: Parser a b -> Parser a c -> Parser a (b,c)
-(>*>) p1 p2 input =
-  [ ((val1,val2),rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
-
--- Apply function to raw result of parse to get required value
--- The supplied function must take account of all the possible parse values
-parseApply :: Parser a b -> ( b -> c ) -> Parser a c
-parseApply p f input = [ (f val,rem) | (val,rem) <- p input ]
-
--- Function used with parseApply to flatten the pairs returned by
--- >*> into a list
--- e.g. toList (item,list) = item:list
-toList :: (a,[a]) -> [a]
-toList = uncurry (:)
-
--- Function used with parseApply to return a value as a singleton list
--- e.g. makeList item = [item]
-makeList :: a -> [a]
-makeList x = [x]
-
--- Function used with parseApply to return a value that is a
--- concatenation of the members of a list.
--- e.g. catList ["ab","cd","ef"] = "abcdef"
-catList :: [[a]] -> [a]
-catList = foldl (++) []
-
--- Indicate completion of expression (or sub-expression),
--- returning given value
-parseReturn :: b -> Parser a b
-parseReturn value input = [(value,input)]
-
--- Parse any number of tokens matching a supplied parse,
--- returning a list of values parsed
--- type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
-parseMany   :: Parser a b -> Parser a [b]
-parseMany p =
-    parseOne ( ( p >*> (parseMany p) ) `parseApply` toList )
-             ( parseReturn [] )
-
--- Parse a sequence of a token matching t1 followed by
--- any number of tokens matching t2, returning a list of
--- tokens thus matched
-parseSequence :: ( a -> Bool , a -> Bool) -> Parser a [a]
-parseSequence ( t1, t2 ) =
-    ( parseItem t1 >*> parseMany ( parseItem t2 ) )
-    `parseApply` toList
-
--- Parse a single token matching selector t, returning that value
-parseItem   :: ( a -> Bool ) -> Parser a a
-parseItem t (next:more)
-    | t next    = [(next,more)]
-    | otherwise = []
-parseItem t []  = []
-
-parseWS :: Parser Char String
-parseWS = parseMany (parseItem isSpace)
-
-parseAlpha :: Parser Char Char
-parseAlpha  =  parseItem isAlpha
-
-parseDigit :: Parser Char Char
-parseDigit  =  parseItem isDigit
-
-parseAlphaNum :: Parser Char Char
-parseAlphaNum  =  parseItem isAlphaNum
-
-parseHexDigit :: Parser Char Char
-parseHexDigit  =  parseItem isHexDigit
-
--- Parse input, returning list of values (all parsers must be same type)
-infixr 5 >:>
-(>:>) :: Parser a b -> Parser a [b] -> Parser a [b]
-(p1 >:> p2) input =
-  [ (val1:val2,rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
-
--- concatenate lists returned by parsers p1 p2
-infixr 5 >++>
-(>++>) :: Parser a [b] -> Parser a [b] -> Parser a [b]
-(p1 >++> p2) input =
-  [ (val1++val2,rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
-
--- skip token matching p1, then use supplied parser p2
-skipToken :: Parser a b -> Parser a c -> Parser a c
-skipToken p1 p2 input =
-  [ res | (_,rem1) <- p1 input, res <- p2 rem1 ]
-
--- Fail if end of input not here, otherwise return supplied value
-parseEnd :: b -> Parser a b
-parseEnd v [] = ( parseReturn v ) []
-parseEnd _ _  = []
-
--- Match null input (returning value ())
-parseNull :: Parser a ()
-parseNull [] = [((),[])]
-parseNull _  = []
-
--- Test if supplied string matches given parser
-isValid :: Parser a b -> [a] -> Bool
-isValid parser input =
-    not ( null ( ( parser >*> parseNull ) input ) )
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/Parse.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: Parse.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.14  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.13  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.12  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.11  2003/03/28 21:50:22  graham
--- Graph equality coded and nearly working
---
--- Revision 1.10  2003/02/27 13:54:30  graham
--- ParseURI module passes unit test
---
--- Revision 1.9  2003/02/27 00:29:53  graham
--- Add additional parse functions for lists of values
---
--- Revision 1.8  2003/02/20 19:44:37  graham
--- Added isValid and parseNull to Pase module.
--- All tests pass.
---
--- Revision 1.7  2003/02/19 20:20:50  graham
--- Some small parser enhancements
---
--- Revision 1.6  2003/02/19 18:45:00  graham
--- Parser unit tests done.
--- Worked out some details for simplified parser construction.
---
--- Revision 1.5  2003/02/13 16:14:14  graham
--- >*> function works
---
--- Revision 1.4  2003/02/13 15:09:47  graham
--- Initial parser tests all pass.
---
--- Revision 1.3  2003/02/13 11:31:18  graham
--- Separate parser tests from parser code
---
--- Revision 1.2  2003/02/07 18:46:07  graham
--- Add new date/time modules
--- Update copyright year
---
--- Revision 1.1  2003/02/02 15:11:15  graham
--- Created new Parsing module
---
---
− Swish/HaskellUtils/ParseTest.hs 
@@ -1,309 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ParseTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ParseTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
--- This module contains test cases for module Parse functions.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUT module Swish.HaskellUtils.ParseTest where
-
-import Test.HUnit
--import Swish.HaskellUtils.Parse
-
-testParser :: ( Show a, Show b, Eq a, Eq b ) => String -> Parser a b -> [a] -> [(b,[a])] -> Test
-testParser s p i r =
-    TestCase ( assertEqual s r ( p i ) )
-
-noResult :: [ ( (),[Char] ) ]
-noResult = []
-
-testParseReturn1 = testParser "parseReturn1" (parseReturn "FOO") ""   [("FOO","")]
-testParseReturn2 = testParser "parseReturn2" (parseReturn "BAR") "**" [("BAR","**")]
-
-testParseItem1 = testParser "parseItem1" (parseItem (=='1')) "2"   []
-testParseItem2 = testParser "parseItem2" (parseItem (=='2')) "abc" []
-testParseItem3 = testParser "parseItem3" (parseItem (=='3')) "3"   [('3',"")]
-testParseItem4 = testParser "parseItem4" (parseItem (=='4')) "456" [('4',"56")]
-testParseItem5 = testParser "parseItem5" (parseItem (=='5')) ""    []
-
-testParseAlpha1 = testParser "parseAlpha1" parseAlpha "123" []
-testParseAlpha2 = testParser "parseAlpha2" parseAlpha "a**" [('a',"**")]
-testParseAlpha3 = testParser "parseAlpha3" parseAlpha "z//" [('z',"//")]
-testParseAlpha4 = testParser "parseAlpha4" parseAlpha "Abc" [('A',"bc")]
-testParseAlpha5 = testParser "parseAlpha5" parseAlpha "Zyx" [('Z',"yx")]
-
-testParseDigit1 = testParser "parseDigit1" parseDigit "ab"   []
-testParseDigit2 = testParser "parseDigit2" parseDigit "1ab"  [('1',"ab")]
-testParseDigit3 = testParser "parseDigit3" parseDigit "9ab"  [('9',"ab")]
-testParseDigit4 = testParser "parseDigit4" parseDigit "55ab" [('5',"5ab")]
-
-testParseAlphaNum1 = testParser "parseAlphaNum1" parseAlphaNum "..." []
-testParseAlphaNum2 = testParser "parseAlphaNum2" parseAlphaNum "a**" [('a',"**")]
-testParseAlphaNum3 = testParser "parseAlphaNum3" parseAlphaNum "z//" [('z',"//")]
-testParseAlphaNum4 = testParser "parseAlphaNum4" parseAlphaNum "Abc" [('A',"bc")]
-testParseAlphaNum5 = testParser "parseAlphaNum5" parseAlphaNum "Zyx" [('Z',"yx")]
-testParseAlphaNum6 = testParser "parseAlphaNum6" parseAlphaNum "123" [('1',"23")]
-testParseAlphaNum7 = testParser "parseAlphaNum7" parseAlphaNum "987" [('9',"87")]
-
-parseAltParser = parseAlt parseDigit parseAlpha
-testParseAlt1 = testParser "parseAlt1" parseAltParser "..." []
-testParseAlt2 = testParser "parseAlt2" parseAltParser "123" [('1',"23")]
-testParseAlt3 = testParser "parseAlt3" parseAltParser "ABC" [('A',"BC")]
-
-parseOneParser = parseOne parseDigit parseAlpha
-testParseOne1 = testParser "parseOne1" parseOneParser "###" []
-testParseOne2 = testParser "parseOne2" parseOneParser "123" [('1',"23")]
-testParseOne3 = testParser "parseOne3" parseOneParser "ABC" [('A',"BC")]
-
-parseOptParser = parseOptional ( parseDigit `parseApply` makeList )
-testParseOpt1 = testParser "parseOpt1" parseOptParser "###" [([],"###")]
-testParseOpt2 = testParser "parseOpt2" parseOptParser "123" [(['1'],"23")]
-testParseOpt3 = testParser "parseOpt3" parseOptParser "ABC" [([],"ABC")]
-
-parseSeqParser
-  = ( parseAlpha >*> p1 ) `parseApply` toList
-    where
-    p1 = ( ( parseItem (== '-') ) >*> p2 )   `parseApply` toList
-    p2 = ( parseDigit >*> (parseReturn []) ) `parseApply` toList
-
-testParseSeq1 = testParser "parseSeq1" parseSeqParser "???"    []
-testParseSeq2 = testParser "parseSeq2" parseSeqParser "A-1>>>" [("A-1",">>>")]
-testParseSeq3 = testParser "parseSeq3" parseSeqParser "Z-9"    [("Z-9","")]
-testParseSeq4 = testParser "parseSeq4" parseSeqParser "1-A>>>" []
-testParseSeq5 = testParser "parseSeq5" parseSeqParser "A#1>>>" []
-
--- parseMany   :: Parser a b -> Parser a [b]
-parseManyParser = parseMany parseDigit
-
-testParseMany1 = testParser "parseMany1" parseManyParser "ab"      [("","ab")]
-testParseMany2 = testParser "parseMany2" parseManyParser "2ab"     [("2","ab")]
-testParseMany3 = testParser "parseMany3" parseManyParser "3"       [("3","")]
-testParseMany4 = testParser "parseMany4" parseManyParser "444"     [("444","")]
-testParseMany5 = testParser "parseMany5" parseManyParser "54321ab" [("54321","ab")]
-testParseMany6 = testParser "parseMany6" parseManyParser ""        [("","")]
-
--- parseSequence :: ( a -> Bool , a -> Bool) -> Parser a [a]
-parseIdParser = parseSequence ( isAlpha, isAlphaNum )
-
-testParseId1 = testParser "parseId1" parseIdParser "123"     []
-testParseId2 = testParser "parseId2" parseIdParser "b2z9"    [("b2z9","")]
-testParseId3 = testParser "parseId3" parseIdParser "c"       [("c","")]
-testParseId4 = testParser "parseId4" parseIdParser "d444**"  [("d444","**")]
-testParseId5 = testParser "parseId5" parseIdParser "efg55.6" [("efg55",".6")]
-testParseId6 = testParser "parseId6" parseIdParser ""        []
-
--- infixr 5 >:>
--- (>:>) :: Parser a b -> Parser a [b] -> Parser a [b]
-
--- skip whitespace then use supplied parser
-skipWS :: Parser Char a -> Parser Char a
-skipWS = skipToken parseWS
-
-parseIdent :: Parser Char String
-parseIdent = parseSequence ( isAlpha, isAlphaNum )
-
-parseNumber :: Parser Char String
-parseNumber = parseSequence ( isDigit, isDigit )
-
--- type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
-parseOp :: String -> Parser Char String
-parseOp op = foldr (>:>) (parseReturn "") [ parseItem (==c) | c <- op ]
-
-parseExprParser = (skipWS parseIdent)     >:>
-                  (skipWS (parseOp ":=")) >:>
-                  (skipWS parseNumber)    >:>
-                  (skipWS (parseOp "+"))  >:>
-                  (skipWS parseNumber )   >:>
-                  (skipWS (parseOp ";"))  >:>
-                  (skipWS (parseReturn []))
-
-testParseExpr1 = testParser "parseExpr1" parseExprParser "// yyy" []
-testParseExpr2 = testParser "parseExpr2" parseExprParser "A:=1+1;"
-                            [(["A",":=","1","+","1",";"],"")]
-testParseExpr3 = testParser "parseExpr3" parseExprParser " B := 2 + 2 ; "
-                            [(["B",":=","2","+","2",";"],"")]
-testParseExpr4 = testParser "parseExpr4" parseExprParser "CCC := 33+34 ; // xxx"
-                            [(["CCC",":=","33","+","34",";"],"// xxx")]
-testParseExpr5 = testParser "parseExpr5" parseExprParser "D5 := 5 + 55 ;//yyy"
-                            [(["D5",":=","5","+","55",";"],"//yyy")]
-testParseExpr6 = testParser "parseExpr6" parseExprParser "D5 :* 5 + 55 ;//yyy" []
-testParseExpr7 = testParser "parseExpr7" parseExprParser "" []
-
-parseExprLstParser = (skipWS parseIdent)     >++>
-                     (skipWS (parseOp ":=")) >++>
-                     (skipWS parseNumber)    >++>
-                     (skipWS (parseOp "+"))  >++>
-                     (skipWS parseNumber )   >++>
-                     (skipWS (parseOp ";"))  >++>
-                     (skipWS (parseReturn []))
-
-testParseExprLst1 = testParser "parseExprLst1" parseExprLstParser
-                            "// yyy"
-                            []
-testParseExprLst2 = testParser "parseExprLst2" parseExprLstParser
-                            "A:=1+1;"
-                            [("A:=1+1;","")]
-testParseExprLst3 = testParser "parseExprLst3" parseExprLstParser
-                            " B := 2 + 2 ; "
-                            [("B:=2+2;","")]
-testParseExprLst4 = testParser "parseExprLst4" parseExprLstParser
-                            "CCC := 33+34 ; // xxx"
-                            [("CCC:=33+34;","// xxx")]
-testParseExprLst5 = testParser "parseExprLst5" parseExprLstParser
-                            "D5 := 5 + 55 ;//yyy"
-                            [("D5:=5+55;","//yyy")]
-testParseExprLst6 = testParser "parseExprLst6" parseExprLstParser
-                            "D5 :* 5 + 55 ;//yyy"
-                            []
-testParseExprLst7 = testParser "parseExprLst7" parseExprLstParser
-                            ""
-                            []
-
-makeListParser = parseManyParser `parseApply` makeList
-
-testMakeList1 = testParser "testMakeList1" makeListParser "ab"  [([""],"ab")]
-testMakeList2 = testParser "testMakeList2" makeListParser "2ab" [(["2"],"ab")]
-
-catListParser = makeListParser `parseApply` catList
-catExprParser = parseExprParser `parseApply` catList
-
-testCatList1 = testParser "testCatList1" catListParser "ab"  [("","ab")]
-testCatList2 = testParser "testCatList2" catListParser "2ab" [("2","ab")]
-testCatList3 = testParser "testCatList3" catExprParser
-                            "D5 := 5 + 55 ;//yyy"   [("D5:=5+55;","//yyy")]
-testCatList4 = testParser "testCatList4" catExprParser
-                            "D5 :* 5 + 55 ;//yyy"   []
-testCatList5 = testParser "testCatList5" catExprParser
-                            ""                      []
-
-testParseNull1 = testParser "parseNull1"
-                 parseNull "a" noResult
-testParseNull2 = testParser "parseNull2"
-                 parseNull "" [((),"")]
-
-testIsValid :: String -> Parser a b -> Bool -> [a] -> Test
-testIsValid label parser match input =
-    TestCase ( assertEqual label match ( (isValid parser) input ) )
-
-testParseEnd1   = testParser "parseEnd1" (parseEnd "") ""   [("",[])]
-testParseEnd2   = testParser "parseEnd2" (parseEnd "") "xx" []
-
-testIsValid1 = testIsValid "testIsValid1" parseExprParser False "// yyy"
-testIsValid2 = testIsValid "testIsValid2" parseExprParser True  "A:=1+1;"
-testIsValid3 = testIsValid "testIsValid3" parseExprParser True  " B := 2 + 2 ; "
-testIsValid4 = testIsValid "testIsValid4" parseExprParser False "CCC := 33+34 ; // xxx"
-testIsValid5 = testIsValid "testIsValid5" parseExprParser False "D5 := 5 + 55 ;//yyy"
-testIsValid6 = testIsValid "testIsValid6" parseExprParser False "D5 :* 5 + 55 ;//yyy"
-testIsValid7 = testIsValid "testIsValid7" parseExprParser False ""
-
-allTests = TestList
-  [ testParseReturn1, testParseReturn2,
-    testParseItem1,  testParseItem2,  testParseItem3,  testParseItem4,  testParseItem5,
-    testParseAlpha1, testParseAlpha2, testParseAlpha3, testParseAlpha4, testParseAlpha5,
-    testParseDigit1, testParseDigit2, testParseDigit3, testParseDigit4,
-    testParseAlphaNum1, testParseAlphaNum2, testParseAlphaNum3, testParseAlphaNum4,
-                        testParseAlphaNum5, testParseAlphaNum6, testParseAlphaNum7,
-    testParseAlt1, testParseAlt2, testParseAlt3,
-    testParseOne1, testParseOne2, testParseOne3,
-    testParseOpt1, testParseOpt2, testParseOpt3,
-    testParseSeq1, testParseSeq2, testParseSeq3, testParseSeq4, testParseSeq5,
-    testParseMany1, testParseMany2, testParseMany3, testParseMany4,
-                    testParseMany5, testParseMany6,
-    testParseId1,   testParseId2,   testParseId3,   testParseId4,
-                    testParseId5,   testParseId6,
-    testParseExpr1, testParseExpr2, testParseExpr3, testParseExpr4,
-                    testParseExpr5, testParseExpr6, testParseExpr7,
-    testParseExprLst1, testParseExprLst2, testParseExprLst3,
-                       testParseExprLst4, testParseExprLst5,
-                       testParseExprLst6, testParseExprLst7,
-    testMakeList1,  testMakeList2,
-    testCatList1,   testCatList2,   testCatList3,   testCatList4,
-    testCatList5,
-    testParseNull1, testParseNull2,
-    testIsValid1,   testIsValid2,   testIsValid3,   testIsValid4,
-                    testIsValid5,   testIsValid6,   testIsValid7,
-    testParseEnd1,  testParseEnd2 ]
-
-main = runTestTT allTests
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ParseTest.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ParseTest.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.12  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.11  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.10  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.9  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.8  2003/02/27 13:54:30  graham
--- ParseURI module passes unit test
---
--- Revision 1.7  2003/02/27 00:29:53  graham
--- Add additional parse functions for lists of values
---
--- Revision 1.6  2003/02/20 19:44:37  graham
--- Added isValid and parseNull to Pase module.
--- All tests pass.
---
--- Revision 1.5  2003/02/19 20:20:50  graham
--- Some small parser enhancements
---
--- Revision 1.4  2003/02/19 18:45:00  graham
--- Parser unit tests done.
--- Worked out some details for simplified parser construction.
---
--- Revision 1.3  2003/02/13 16:14:14  graham
--- >*> function works
---
--- Revision 1.2  2003/02/13 15:09:47  graham
--- Initial parser tests all pass.
---
--- Revision 1.1  2003/02/13 11:31:18  graham
--- Separate parser tests from parser code
---
− Swish/HaskellUtils/ParseURI.hs 
@@ -1,503 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ParseURI.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ParseURI
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a collection of functions for parsing URIs.
---
---  These are used mainly as helper functions by the module URI.
---
---  The current official reference for URI handling is RFC2396 [1],
---  as updated by RFC 2732 [2].
---
---  These are being merged into RFC2396bis [3], a work-in-progress copy of
---  which is available at the URI indicated.  This document has been used
---  as the primary reference for constructing the URI parser implemented
---  here, and it is intended that there is a direct relationship between
---  the syntax definition in that document and the parser implementation.
---
---  [1] http://www.ietf.org/rfc/rfc2396.txt
---  [2] http://www.ietf.org/rfc/rfc2732.txt
---  [3] http://www.apache.org/~fielding/uri/rev-2002/rfc2396bis.html
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.ParseURI
-  ( URI(URI),
-    absoluteUri, relativeUri, uriReference, absoluteUriReference,
-    uriToString,
-    hostname, ipv4address, ipv6address, relSegmentWithColon
-    ) where
-
-    -- absoluteUri :: Parser Char URI           -- no fragment
-    -- relativeUri :: Parser Char URI           -- no fragment
-    -- uriReference :: Parser Char URI          -- optional fragment
-    -- absoluteUriReference :: Parser Char URI  -- absolute with opt frag
-    -- uriToString :: URI -> String
-    -- hostname :: Parser Char String
-    -- ipv4address :: Parser Char String
-    -- ipv6address :: Parser Char String
-
-    -- Declare imports used from Parser module
-    import qualified Swish.HaskellUtils.Parse as Parse--    type Parser a b = Parse.Parser a b
--    isOneOf :: Eq a => [a] -> a -> Bool
-    isOneOf       = Parse.isOneOf
--    isAlpha       :: Char -> Bool-    isAlpha       = Parse.isAlpha
--    isDigit       :: Char -> Bool-    isDigit       = Parse.isDigit
--    isAlphaNum    :: Char -> Bool-    isAlphaNum    = Parse.isAlphaNum
--    isHexDigit    :: Char -> Bool-    isHexDigit    = Parse.isHexDigit
--    parseApply    = Parse.parseApply
-    parseReturn   = Parse.parseReturn
-    parseOne      = Parse.parseOne
-    parseAlt      = Parse.parseAlt
-    parseOptional = Parse.parseOptional
-    parseSequence = Parse.parseSequence
-    parseMany     = Parse.parseMany
-    parseItem     = Parse.parseItem
-    catList       = Parse.catList
-    makeList      = Parse.makeList
-    (>++>)        = (Parse.>++>)
-    (>:>)         = (Parse.>:>)
-    (>*>)         = (Parse.>*>)
--    alphanumCh    :: String-    alphanumCh    = Parse.alphanum
-
-    -- Generic URI parser
-    -- Each parser rule is a local function definition,
-    -- mostly based on the function type:  Parser Char String
-    -- e.g. parseURI :: Parser Char URI
-
-    -- Internal data type for URI
-    -- Components are:
-    --   scheme authority [segments] query fragment
-    --   e.g.
-    --     "http:" "//example.org" ["/","dir/","file"] "?q" "#f"
-    --     "mailto:" "" ["local@domain"] "" "#f"
-    --
-    -- Note: opaque paths are presented as an authority string with
-    --       empty list of segments and query values.  I think (?) this
-    --       yields the correct behaviour when working with relative URIs
-    -- Note: if the final path segment ends with a "/", an empty segment
-    --       is appended to the segment list.  Thus, the final element
-    --       of the list corresponds (roughly) to a filename rather than
-    --       a directory name.
-    --
-    data URI = URI String String [String] String String
-        deriving ( Eq, Show )
-    type URIPath = (String,[String],String)
-
-    makeAbsUri   (s,(a,p,q))         = URI s a p q ""
-    makeRelUri   (a,p,q)             = URI "" a p q ""
-    setFragment  (URI s a p q _, f1) = URI s a p q f1
-    makeHierPath ((a,p),q)           = (a,p,q)
-    makeOpaqPath s                   = (s,[],"")
--    nullURI                          :: URI-    nullURI                          = URI "" "" [] "" ""
-
-    uriToString :: URI -> String
-    uriToString (URI sch aut seg qry frag) =
-        sch++aut++(foldl (++) [] seg)++qry++frag
-
-    -- Local helper functions
-    nullStr  = parseReturn []
-    alt      = parseAlt
-    one      = parseOne
-    oneOf    = foldr1 one
-    anyOf    = foldr1 alt
-    opt p    = alt p nullStr
-    rep p    = alt ( p >++> (rep p) ) ( parseReturn [] )
-    no p inp = if null (p inp) then [([],inp)] else []
-    -- optG and repG are "greedy" versions of opt and rep
-    optG p   = one p nullStr
-    repG p   = one ( p >++> (repG p) ) ( parseReturn [] )
-
-    char c   = cclass (==c)
-    cclass t = (parseItem t ) `parseApply` makeList
-
-    count (mn,mx) p = ( ( countEq mn p ) >++> ( countMax (mx-mn) p ) )
-    countEq n p
-        | n > 0     = ( p >++> ( countEq (n-1) p ) )
-        | otherwise = parseReturn []
-    countMax n p
-        | n > 0     = opt ( p >++> ( countMax (n-1) p ) )
-        | otherwise = parseReturn []
-
-    -- Syntax copied almost verbatim from RFC2396bis:
-    -- http://www.apache.org/~fielding/uri/rev-2002/rfc2396bis.html
-
-    -- Character parsers
-
-    -- misc
-    alpha    :: String -> [(String, String)]-    alpha    = (cclass isAlpha)
--    alphanum :: String -> [(String, String)]-    alphanum = (cclass isAlphaNum)
--    alnumhyp :: String -> [(String, String)]-    alnumhyp = alt (cclass isAlphaNum) (char '-')
--    digit    :: String -> [(String, String)]-    digit    = (cclass isDigit)
--    hexdigit :: String -> [(String, String)]-    hexdigit = (cclass isHexDigit)
--    dot      :: String -> [(String, String)]-    dot      = (char '.')
--    slash    :: String -> [(String, String)]-    slash    = (char '/')
--    colon    :: String -> [(String, String)]-    colon    = (char ':')
-
--    -- sect 2
-    uric :: String -> [(String, String)]-    uric = oneOf [ reserved, unreserved, escaped ]
-
-    -- sect 3
-    uricNoSlash :: String -> [(String, String)]-    uricNoSlash = oneOf
-          [ unreserved,
-            (char '['),
-            (char ']'),
-            (char ';'),
-            (char '?'),
-            (char ':'),
-            (char '@'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ','),
-            escaped  ]
-    -- sect 2.2
-    reserved :: String -> [(String, String)]-    reserved = oneOf
-          [ (char '['),
-            (char ']'),
-            (char ';'),
-            (char '/'),
-            (char '?'),
-            (char ':'),
-            (char '@'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ',') ]
-    -- sect 2.3
-    unreserved :: String -> [(String, String)]-    unreserved = oneOf
-          [ (cclass isAlpha),
-            (cclass isDigit),
-            mark ]
-    mark :: String -> [(String, String)]-    mark = oneOf
-          [ (char '-'),
-            (char '_'),
-            (char '.'),
-            (char '!'),
-            (char '~'),
-            (char '*'),
-            (char '\''),
-            (char '('),
-            (char ')') ]
-    -- sect 2.4.1
-    escaped :: String -> [(String, String)]-    escaped = (char '%') >++> hexdigit >++> hexdigit
-    -- sect 3.3
-    pchar :: String -> [(String, String)]-    pchar = oneOf
-          [ unreserved,
-            (char ';'),
-            (char ':'),
-            (char '@'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ','),
-            escaped  ]
-
-    -- URI parser
-
-    -- sect 3  (see also section 4.3)
-    -- absoluteUri -> URI scheme: Path ""
-    absoluteUri :: Parser Char URI
-    absoluteUri = (scheme >++> colon) >*> (alt hierPart opaquePart)
-                  `parseApply` makeAbsUri
-
-    hierPart :: Parser Char URIPath
-    hierPart    = (one netPath absPath) >*> optG ((char '?') >++> query)
-                  `parseApply` makeHierPath
-    netPath :: Parser Char (String,[String])
-    netPath     = (slash >++> slash >++> authority) >*> (optG absPath1)
-    absPath :: Parser Char (String,[String])
-    absPath     = nullStr >*> absPath1
-    absPath1 :: Parser Char [String]
-    absPath1    = slash >:> pathSegments
-
-    opaquePart :: Parser Char URIPath
-    opaquePart  = uricNoSlash >++> ( repG uric )
-                  `parseApply` makeOpaqPath
-
-    -- sect 3.1
-    scheme :: Parser Char String
-    scheme = parseSequence ( isAlpha, (isOneOf (alphanumCh++"+-.")) )
-
-    -- sect 3.2
-    authority :: Parser Char String
-    authority = oneOf [ server, regName, nullStr ]
-
-    -- sect 3.2.1
-    regName :: Parser Char String
-    regName = regChar >++> ( repG regChar )
-    regChar :: String -> [(String, String)]-    regChar = oneOf
-          [ unreserved,
-            (char ';'),
-            (char ':'),
-            (char '@'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ','),
-            escaped ]
-
-    -- sect 3.2.2
-    -- NOTE: blank server option is handled by 'authority' production
-    server :: Parser Char String
-    server      = opt ( userinfo >++> (char '@') ) >++> hostport
-    userinfo    :: String -> [(String, String)]-    userinfo    = uinfoCh >++> ( repG uinfoCh )
-    uinfoCh     :: String -> [(String, String)]-    uinfoCh     = oneOf
-          [ unreserved,     -- regChar without '@'
-            (char ';'),
-            (char ':'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ','),
-            escaped ]
-    hostport    :: String -> [(String, String)]-    hostport    = host >++> ( optG ( colon >++> port ) )
-    host        :: String -> [(String, String)]-    host        = oneOf [ ipv6reference, ipv4address, hostname ]
-    port        :: String -> [(String, String)]-    port        = repG digit
-
-    hostname :: Parser Char String
-    hostname    = domainlabel >++> ( optG qualified )
-    qualified   :: String -> [(String, String)]-    qualified   = ( rep ( dot >++> domainlabel ) ) >++>
-                  ( opt ( dot >++> toplabel >++> dot >++> (no alphanum) ) ) >++>
-                  ( no dot )   -- force all available domain labels to be taken
-    domainlabel :: String -> [(String, String)]-    domainlabel = alphanum >++> morelabel
-    toplabel    :: String -> [(String, String)]-    toplabel    = alpha    >++> morelabel
-    morelabel   :: String -> [(String, String)]-    morelabel   = optG ( ( countMax 61 alnumhyp ) >++> alphanum
-                         >++> (no alnumhyp) )
-
-    ipv4address :: String -> [(String, String)]-    ipv4address = decoctet >++> dot >++> decoctet
-                           >++> dot >++> decoctet
-                           >++> dot >++> decoctet
-    decoctet    :: String -> [(String, String)]-    decoctet    = anyOf
-          [ digit,
-            digit19 >++> digit,
-            (char '1') >++> digit >++> digit,
-            (char '2') >++> digit04 >++> digit,
-            (char '2') >++> (char '5') >++> digit05 ]
-    digit19     :: String -> [(String, String)]-    digit19     = (cclass (isOneOf "123456789") )
-    digit12     :: String -> [(String, String)]-    digit12     = (cclass (isOneOf "12") )
-    digit04     :: String -> [(String, String)]-    digit04     = (cclass (isOneOf "01234") )
-    digit05     :: String -> [(String, String)]-    digit05     = (cclass (isOneOf "012345") )
-
-    ipv6reference :: String -> [(String, String)]-    ipv6reference = (char '[') >++> ipv6address >++> (char ']')
-    ipv6address :: String -> [(String, String)]-    ipv6address = anyOf
-          [                           (countEq 6 h4c) >++> ls32,
-                              cc >++> (countEq 5 h4c) >++> ls32,
-            opt h4       >++> cc >++> (countEq 4 h4c) >++> ls32,
-            (n_h4c_h4 1) >++> cc >++> (countEq 3 h4c) >++> ls32,
-            (n_h4c_h4 2) >++> cc >++> (countEq 2 h4c) >++> ls32,
-            (n_h4c_h4 3) >++> cc >++>            h4c  >++> ls32,
-            (n_h4c_h4 4) >++> cc >++>                      ls32,
-            (n_h4c_h4 5) >++> cc >++>                      h4,
-            (n_h4c_h4 5) >++> cc ]
-    h4c         = h4 >++> colon
-    n_h4c_h4 n  = opt ( (countMax n h4c) >++> h4 )
-    cc          :: String -> [(String, String)]-    cc          = colon >++> colon
-    h4          :: String -> [(String, String)]-    h4          = count (1,4) hexdigit
-    ls32          :: String -> [(String, String)]-    ls32        = alt (h4c >++> h4) ipv4address
-
-    -- sect 3.3
-    pathSegments :: Parser Char [String]
-    pathSegments = one ( (segment >++> slash) >:> pathSegments )
-                       ( segment `parseApply` makeList )-    segment      :: String -> [(String, String)]-    segment      = repG pchar
-
-    -- sect 3.4
-    query :: Parser Char String
-    query        = repG ( oneOf [ pchar, slash, (char '?') ] )
-
-    -- sect 4
-    uriReference :: Parser Char URI
-    uriReference = ( ( oneOf [ absoluteUri, relativeUri, emptyURI ] )
-                     >*> optfrag )
-                   `parseApply` setFragment
-    emptyURI     = parseReturn nullURI
-    optfrag      :: String -> [(String, String)]-    optfrag      = optG ( (char '#') >++> fragment )
-
-    absoluteUriReference :: Parser Char URI
-    absoluteUriReference = ( absoluteUri >*> optfrag )
-                           `parseApply` setFragment
-
-    -- sect 4.1
-    fragment :: Parser Char String
-    fragment     = repG ( oneOf [ pchar, slash, (char '?') ] )
-
-    -- sect 5
-    relativeUri :: Parser Char URI
-    relativeUri  = ( oneOf [ netPath, absPath, relPath, nulPath ] >*>
-                     optG ((char '?') >++> query)
-                    `parseApply` makeHierPath )
-                  `parseApply` makeRelUri
-
-    nulPath :: Parser Char (String,[String])
-    nulPath     = parseReturn ("",[])
-
-    relPath :: Parser Char (String,[String])
---    relPath      = nullStr >*> (relSegment >:> optG absPath1)
-    relPath      = nullStr >*> one ( relSegment >++> slash >:> pathSegments )
-                                   ( relSegment `parseApply` makeList )
-                                   -- [[[TODO: factor higher order function
-                                   -- for relPath and pathSegments]]]
-
-    relSegment   :: Parser Char String
-    relSegment   = relSegCh >++> (repG relSegCh)
-    relSegCh     :: String -> [(String, String)]-    relSegCh     = oneOf
-          [ unreserved,     -- pchar without ':'
-            (char ';'),
-            (char '@'),
-            (char '&'),
-            (char '='),
-            (char '+'),
-            (char '$'),
-            (char ','),
-            escaped  ]
-
-    relSegmentWithColon :: Parser Char String
-    relSegmentWithColon = relSegment >++> colon >++> segment
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ParseURI.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ParseURI.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.11  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.10  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.9  2003/05/20 23:35:28  graham
--- Modified code to compile with GHC hierarchical libraries
---
--- Revision 1.8  2003/03/05 22:16:23  graham
--- URI code passes all unit tests
---
--- Revision 1.7  2003/03/05 14:47:45  graham
--- Relative URI code complete, not tested
--- Fixed a URI parser bug
---
--- Revision 1.6  2003/02/27 20:29:53  graham
--- Fixed some more parser bugs.
--- All parser tests pass.
--- QName and relative path handling to do.
---
--- Revision 1.5  2003/02/27 18:48:05  graham
--- Fix URI parser bug.
--- Add more URI parser test cases.
---
--- Revision 1.4  2003/02/27 15:28:45  graham
--- Updated internal structure of parsed URI.
--- Passes parser unit tests
---
--- Revision 1.3  2003/02/27 13:54:30  graham
--- ParseURI module passes unit test
---
--- Revision 1.2  2003/02/27 09:50:25  graham
--- Add URI parser test cases, some name changes
---
--- Revision 1.1  2003/02/27 08:59:53  graham
--- Separate URI parser from main URI module
---
− Swish/HaskellUtils/ParseURITest.hs 
@@ -1,491 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ParseURITest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ParseURITest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines test cases for module ParseURI.
---
---  The tests here are intended to be confidence-setting rather than
---  exhaustive:  the module URITest exercises a far wider range of
---  URI forms, via the URI module which uses this parser to break a
---  URI into its component parts.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUT module Swish.HaskellUtils.ParseURITest where
-
-import Test.HUnit
-import Swish.HaskellUtils.Parse
-import Swish.HaskellUtils.ParseURI
-import System.IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )
-
-testParser :: ( Show a, Show b, Eq a, Eq b ) =>
-    String -> Parser a b -> [a] -> [(b,[a])] -> Test
-testParser lab parser inp res =
-    TestCase ( assertEqual lab res (pend inp) )
-    where
-    pend = ( parser >*> (parseEnd []) ) `parseApply` fst
-
--- hostname
-
-hostnameTest lab inp res =
-    testParser ("hostnameTest"++lab) hostname inp res
-
-hostnameTest01 = hostnameTest "01" "example.org" [ ("example.org","") ]
-
-hostnameTests = TestList
-      [ hostnameTest01 --, hostnameTest02, hostnameTest03, hostnameTest04,
-      ]
-
--- ipv6
-
-ipv6Test lab inp res =
-    testParser ("ipv6Test"++lab) ipv6address inp res
-
-ipv6Test01 = ipv6Test "01" "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210"
-                [ ("FEDC:BA98:7654:3210:FEDC:BA98:7654:3210","") ]
-
-ipv6Test02 = ipv6Test "02" "FEDC:BA98:7654:3210:FEDC:BA98:192.9.5.5"
-                [ ("FEDC:BA98:7654:3210:FEDC:BA98:192.9.5.5","") ]
-
-ipv6Test03 = ipv6Test "03" "1080:0:0:0:8:800:200C:417A"
-                [ ("1080:0:0:0:8:800:200C:417A","") ]
-
-ipv6Test04 = ipv6Test "04" "3ffe:2a00:100:7031::1"
-                [ ("3ffe:2a00:100:7031::1","") ]
-
-ipv6Test05 = ipv6Test "05" "1080::8:800:200C:417A"
-                [ ("1080::8:800:200C:417A","") ]
-
-ipv6Test06 = ipv6Test "06" "::192.9.5.5"
-                [ ("::192.9.5.5","") ]
-
-ipv6Test07 = ipv6Test "07" "::FFFF:129.144.52.38"
-                [ ("::FFFF:129.144.52.38","") ]
-
-ipv6Test08 = ipv6Test "08" "2010:836B:4179::836B:4179"
-                [ ("2010:836B:4179::836B:4179","") ]
-
-ipv6Test09 = ipv6Test "09" "::200C:417A"
-                [ ("::200C:417A","") ]
-
-ipv6Test10 = ipv6Test "10" "::417A"
-                [ ("::417A","") ]
-
-ipv6Test11 = ipv6Test "11" "3ffe:2a00::417A"
-                [ ("3ffe:2a00::417A","") ]
-
-ipv6Tests = TestList
-      [ ipv6Test01, ipv6Test02, ipv6Test03, ipv6Test04,
-        ipv6Test05, ipv6Test06, ipv6Test07, ipv6Test08,
-        ipv6Test09, ipv6Test10, ipv6Test11
-      ]
-
--- absoluteUri :: Parser Char URI
-
-absoluteUriTest lab inp res =
-    testParser ("absoluteUriTest"++lab++": "++inp) absoluteUri inp res
-
-absoluteUriTest01 = absoluteUriTest "01"
-    "http://example.org/aaa/bbb"
-    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
-
-absoluteUriTest02 = absoluteUriTest "02"
-    "mailto:local@domain.org"
-    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
-
-absoluteUriTest03 = absoluteUriTest "03"
-    "mailto:local@domain.org"
-    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
-
-absoluteUriTest04 = absoluteUriTest "04"
-    "HTTP://EXAMPLE.ORG/AAA/BBB"
-    [ ( URI "HTTP:" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "", "" ) ]
-
-absoluteUriTest05 = absoluteUriTest "05"
-    "http://example.org/aaa/bbb?qqq/rrr"
-    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "", "" ) ]
-
-absoluteUriTest06 = absoluteUriTest "06"
-    "//example.org/aaa/bbb"
-    []
-
-absoluteUriTest07 = absoluteUriTest "07"
-    "/aaa/bbb"
-    []
-
-absoluteUriTest08 = absoluteUriTest "08"
-    "bbb"
-    []
-
-absoluteUriTest09 = absoluteUriTest "09"
-    "#ccc"
-    []
-
-absoluteUriTest10 = absoluteUriTest "10"
-    "#"
-    []
-
-absoluteUriTest11 = absoluteUriTest "11"
-    "/"
-    []
-
-absoluteUriTest12 = absoluteUriTest "12"
-    "http://[1080::8:800:200C:417A]/foo"
-    [ ( URI "http:" "//[1080::8:800:200C:417A]" ["/","foo"] "" "", "" ) ]
-
-absoluteUriTest13 = absoluteUriTest "13"
-    "http://[::192.9.5.5]/ipng"
-    [ ( URI "http:" "//[::192.9.5.5]" ["/","ipng"] "" "", "" ) ]
-
-absoluteUriTest14 = absoluteUriTest "14"
-    "http://[1080::8:800:192.9.5.5]/foo"
-    [ ( URI "http:" "//[1080::8:800:192.9.5.5]" ["/","foo"] "" "", "" ) ]
-
-absoluteUriTest15 = absoluteUriTest "15"
-    "http://[::200C:417A]/ipng"
-    [ ( URI "http:" "//[::200C:417A]" ["/","ipng"] "" "", "" ) ]
-
-absoluteUriTest16 = absoluteUriTest "16"
-    "http://[::417A]/ipng"
-    [ ( URI "http:" "//[::417A]" ["/","ipng"] "" "", "" ) ]
-
-absoluteUriTest17 = absoluteUriTest "17"
-    "http://192.9.5.5/ipng"
-    [ ( URI "http:" "//192.9.5.5" ["/","ipng"] "" "", "" ) ]
-
-absoluteUriTest18 = absoluteUriTest "18"
-    "http://example.org:/aaa/bbb"
-    [ ( URI "http:" "//example.org:" ["/","aaa/","bbb"] "" "", "" ) ]
-
-absoluteUriTests = TestList
-      [ absoluteUriTest01, absoluteUriTest02, absoluteUriTest03,
-        absoluteUriTest04, absoluteUriTest05, absoluteUriTest06,
-        absoluteUriTest07, absoluteUriTest08, absoluteUriTest09,
-        absoluteUriTest10, absoluteUriTest11, absoluteUriTest12,
-        absoluteUriTest13, absoluteUriTest14, absoluteUriTest15,
-        absoluteUriTest16, absoluteUriTest17, absoluteUriTest18 ]
-
--- relativeUri :: Parser Char URI
-
-relativeUriTest lab inp res =
-    testParser ("relativeUriTest"++lab) relativeUri inp res
-
-relativeUriTest01 = relativeUriTest "01"
-    "//example.org/aaa/bbb"
-    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
-
-relativeUriTest02 = relativeUriTest "02"
-    "local@domain.org"
-    [ ( URI "" "" ["local@domain.org"] "" "", "" ) ]
-
-relativeUriTest03 = relativeUriTest "03"
-    "mailto:local@domain.org"
-    []
-
-relativeUriTest04 = relativeUriTest "04"
-    "//EXAMPLE.ORG/AAA/BBB"
-    [ ( URI "" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "", "" ) ]
-
-relativeUriTest05 = relativeUriTest "05"
-    "//example.org/aaa/bbb?qqq/rrr"
-    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "", "" ) ]
-
-relativeUriTest06 = relativeUriTest "06"
-    "//example.org/aaa/bbb"
-    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
-
-relativeUriTest07 = relativeUriTest "07"
-    "/aaa/bbb"
-    [ ( URI "" "" ["/","aaa/","bbb"] "" "", "" ) ]
-
-relativeUriTest08 = relativeUriTest "08"
-    "bbb"
-    [ ( URI "" "" ["bbb"] "" "", "" ) ]
-
-relativeUriTest09 = relativeUriTest "09"
-    "#ccc"
-    []
-
-relativeUriTest10 = relativeUriTest "10"
-    "#"
-    []
-
-relativeUriTest11 = relativeUriTest "11"
-    "/"
-    [ ( URI "" "" ["/",""] "" "", "" ) ]
-
-relativeUriTest12 = relativeUriTest "12"
-    "/aaa/"
-    [ ( URI "" "" ["/","aaa/",""] "" "", "" ) ]
-
-relativeUriTest13 = relativeUriTest "13"
-    "/aaa/?bbb"
-    [ ( URI "" "" ["/","aaa/",""] "?bbb" "", "" ) ]
-
-relativeUriTest14 = relativeUriTest "14"
-    "?y"
-    [ ( URI "" "" [] "?y" "", "" ) ]
-
-relativeUriTest15 = relativeUriTest "15"
-    "g?y"
-    [ ( URI "" "" ["g"] "?y" "", "" ) ]
-
-relativeUriTest16 = relativeUriTest "16"
-    "g;x?y#s"
-    []
-
-
-relativeUriTests = TestList
-      [ relativeUriTest01, relativeUriTest02, relativeUriTest03,
-        relativeUriTest04, relativeUriTest05, relativeUriTest06,
-        relativeUriTest07, relativeUriTest08, relativeUriTest09,
-        relativeUriTest10, relativeUriTest11, relativeUriTest12,
-        relativeUriTest13, relativeUriTest14, relativeUriTest15,
-        relativeUriTest16 ]
-
-
--- uriReference :: Parser Char URI
-
-uriReferenceTest lab inp res =
-    testParser ("uriReferenceTest"++lab) uriReference inp res
-
-uriReferenceTest01 = uriReferenceTest "01"
-    "http://example.org/aaa/bbb#ccc"
-    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
-
-uriReferenceTest02 = uriReferenceTest "02"
-    "mailto:local@domain.org"
-    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
-
-uriReferenceTest03 = uriReferenceTest "03"
-    "mailto:local@domain.org#frag"
-    [ ( URI "mailto:" "local@domain.org" [] "" "#frag", "" ) ]
-
-uriReferenceTest04 = uriReferenceTest "04"
-    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-    [ ( URI "HTTP:" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "#CCC", "" ) ]
-
-uriReferenceTest05 = uriReferenceTest "05"
-    "http://example.org/aaa/bbb?qqq/rrr#ccc"
-    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "#ccc", "" ) ]
-
-uriReferenceTest06 = uriReferenceTest "06"
-    "//example.org/aaa/bbb#ccc"
-    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
-
-uriReferenceTest07 = uriReferenceTest "07"
-    "/aaa/bbb#ccc"
-    [ ( URI "" "" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
-
-uriReferenceTest08 = uriReferenceTest "08"
-    "bbb#ccc"
-    [ ( URI "" "" ["bbb"] "" "#ccc", "" ) ]
-
-uriReferenceTest09 = uriReferenceTest "09"
-    "#ccc"
-    [ ( URI "" "" [] "" "#ccc", "" ) ]
-
-uriReferenceTest10 = uriReferenceTest "10"
-    "#"
-    [ ( URI "" "" [] "" "#", "" ) ]
-
-uriReferenceTest11 = uriReferenceTest "11"
-    "/"
-    [ ( URI "" "" ["/",""] "" "", "" ) ]
-
-uriReferenceTest12 = uriReferenceTest "12"
-    "/aaa/#fff/ggg"
-    [ ( URI "" "" ["/","aaa/",""] "" "#fff/ggg", "" ) ]
-
-uriReferenceTest13 = uriReferenceTest "13"
-    "/aaa/?bbb/ccc#fff/ggg"
-    [ ( URI "" "" ["/","aaa/",""] "?bbb/ccc" "#fff/ggg", "" ) ]
-
-uriReferenceTest14 = uriReferenceTest "14"
-    "?y"
-    [ ( URI "" "" [] "?y" "", "" ) ]
-
-uriReferenceTest15 = uriReferenceTest "15"
-    "g?y"
-    [ ( URI "" "" ["g"] "?y" "", "" ) ]
-
-uriReferenceTest16 = uriReferenceTest "16"
-    "g;x?y#s"
-    [ ( URI "" "" ["g;x"] "?y" "#s", "" ) ]
-
-uriReferenceTest17 = uriReferenceTest "17"
-    "http://example.123./aaa/bbb#ccc"
-    [ ]
-
-uriReferenceTest18 = uriReferenceTest "18"
-    "http://example.org:/aaa/bbb#ccc"
-    [ ( URI "http:" "//example.org:" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
-
-uriReferenceTest19 = uriReferenceTest "19"
-    "http://example/Andr&#567;"
-    [ ( URI "http:" "//example" ["/","Andr&"] "" "#567;", "" ) ]
-
-uriReferenceTest20 = uriReferenceTest "20"
-    "abc/def"
-    [ ( URI "" "" ["abc/", "def"] "" "", "" ) ]
-
-uriReferenceTest21 = uriReferenceTest "21"
-    "../abc#def"
-    [ ( URI "" "" ["../","abc"] "" "#def", "" ) ]
-
-uriReferenceTest22 = uriReferenceTest "22"
-    "file://meetings.example.com/cal#m1"
-    [ ( URI "file:" "//meetings.example.com" ["/","cal"] "" "#m1", "" ) ]
-
-
-uriReferenceTests = TestList
-      [ uriReferenceTest01, uriReferenceTest02, uriReferenceTest03,
-        uriReferenceTest04, uriReferenceTest05, uriReferenceTest06,
-        uriReferenceTest07, uriReferenceTest08, uriReferenceTest09,
-        uriReferenceTest10, uriReferenceTest11, uriReferenceTest12,
-        uriReferenceTest13, uriReferenceTest14, uriReferenceTest15,
-        uriReferenceTest16, uriReferenceTest17, uriReferenceTest18,
-        uriReferenceTest19, uriReferenceTest20, uriReferenceTest21,
-        uriReferenceTest22 ]
-
--- Check for ambiguous parse:
--- These tests don't force end-of-input, so potential ambiguous parses can be detected,
-
-uriAmbiguousTest lab inp res =
-    TestCase ( assertEqual ("uriAmbiguousTest"++lab++": "++inp) res (uriReference inp) )
-
-uriAmbiguousTest01 = uriAmbiguousTest "01"
-    "http://example.org/aaa/bbb#ccc"
-    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
-
-uriAmbiguousTest02 = uriAmbiguousTest "02"
-    "mailto:local@domain.org"
-    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
-
-uriAmbiguousTest03 = uriAmbiguousTest "03"
-    "mailto:local@domain.org#frag"
-    [ ( URI "mailto:" "local@domain.org" [] "" "#frag", "" ) ]
-
-uriAmbiguousTest04 = uriAmbiguousTest "04"
-    "file://meetings.example.com/cal#m1"
-    [ ( URI "file:" "//meetings.example.com" ["/","cal"] "" "#m1", "" ) ]
-
-
-uriAmbiguousTests = TestList
-  [ uriAmbiguousTest01, uriAmbiguousTest02, uriAmbiguousTest03, uriAmbiguousTest04 ]
-
-
--- All tests
-
-allTests = TestList
-  [ hostnameTests,
-    ipv6Tests,
-    absoluteUriTests,
-    relativeUriTests,
-    uriReferenceTests,
-    uriAmbiguousTests
-  ]
-
-main = runTestTT allTests
-
-hn     = hostnameTests
-ipv6   = ipv6Tests
-absu   = absoluteUriTests
-absu01 = absoluteUriTest01
-relu   = relativeUriTests
-uref   = uriReferenceTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-tp p s = runTestTT ( testParser "tp" p s [("<",">")] )
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ParseURITest.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ParseURITest.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.13  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.12  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.11  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.10  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.9  2003/03/05 22:16:23  graham
--- URI code passes all unit tests
---
--- Revision 1.8  2003/03/05 14:47:45  graham
--- Relative URI code complete, not tested
--- Fixed a URI parser bug
---
--- Revision 1.7  2003/02/28 14:02:52  graham
--- A few new test cases
---
--- Revision 1.6  2003/02/27 23:33:54  graham
--- QName splitting tested OK
---
--- Revision 1.5  2003/02/27 20:29:53  graham
--- Fixed some more parser bugs.
--- All parser tests pass.
--- QName and relative path handling to do.
---
--- Revision 1.4  2003/02/27 18:48:05  graham
--- Fix URI parser bug.
--- Add more URI parser test cases.
---
--- Revision 1.3  2003/02/27 15:28:45  graham
--- Updated internal structure of parsed URI.
--- Passes parser unit tests
---
--- Revision 1.2  2003/02/27 13:54:30  graham
--- ParseURI module passes unit test
---
--- Revision 1.1  2003/02/20 19:45:07  graham
--- Add URI module and unit tests.
--- Code incomplete.
---
− Swish/HaskellUtils/PartOrderedCollection.hs 
@@ -1,392 +0,0 @@---------------------------------------------------------------------------------
---  $Id: PartOrderedCollection.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  PartOrderedCollection
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module provides methods to support operations on partially ordered
---  collections.  The partial ordering relationship is represented by
---  Maybe Ordering.
---
---  Thanks to members of the haskell-cafe mailing list:
---    Robert <rvollmert-lists@gmx.net>
---    Tom Pledger <Tom.Pledger@peace.com>
---  who suggested key ideas on which some of the code in this module is based.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.PartOrderedCollection
-    ( PartCompare
-    , minima, maxima
-    , partCompareEq, partCompareOrd, partComparePair
-    , partCompareListPartOrd, partCompareListOrd
-    , partCompareMaybe, partCompareListMaybe
-    , partCompareListSubset
-    )
-where
-
-{- in Prelude????-import Maybe
-    ( Maybe(..) )
--}-
-------------------------------------------------------------
---  Type of partial compare function
-------------------------------------------------------------
-
-type PartCompare a = a -> a -> Maybe Ordering
-
-------------------------------------------------------------
---  Functions for minima and maxima of a part-ordered list
-------------------------------------------------------------
-
--- |This function finds the maxima in a list of partially
---  ordered values, preserving the sequence of retained
---  values from the supplied list.
---
---  It returns all those values in the supplied list
---  for which there is no larger element in the list.
---
-maxima :: PartCompare a -> [a] -> [a]
-maxima cmp as = foldl add [] as
-    where
-        add []     e = [e]
-        add ms@(m:mr) e = case cmp m e of
-            Nothing -> m:(add mr e)
-            Just GT -> ms
-            Just EQ -> ms
-            Just LT -> add mr e
-
--- |This function finds the minima in a list of partially
---  ordered values, preserving the sequence of retained
---  values from the supplied list.
---
---  It returns all those values in the supplied list
---  for which there is no smaller element in the list.
---
-minima :: PartCompare a -> [a] -> [a]
-minima cmp = maxima (flip cmp)
-
-------------------------------------------------------------
---  Partial ordering comparison functions
-------------------------------------------------------------
-
--- |Partial ordering for Eq values
-partCompareEq :: (Eq a) => a -> a -> Maybe Ordering
-partCompareEq a1 a2 = if a1 == a2 then Just EQ else Nothing
-
--- |Partial ordering for Ord values
-partCompareOrd :: (Ord a) => a -> a -> Maybe Ordering
-partCompareOrd a1 a2 = Just $ compare a1 a2
-
--- |Part-ordering comparison on pairs of values,
---  where each has a part-ordering relationship
-partComparePair ::
-    (a->a->Maybe Ordering) -> (b->b->Maybe Ordering) -> (a,b) -> (a,b)
-    -> Maybe Ordering
-partComparePair cmpa cmpb (a1,b1) (a2,b2) = case (cmpa a1 a2,cmpb b1 b2) of
-    (_,Nothing)       -> Nothing
-    (jc1,Just EQ)     -> jc1
-    (Nothing,_)       -> Nothing
-    (Just EQ,jc2)     -> jc2
-    (Just c1,Just c2) -> if c1 == c2 then Just c1 else Nothing
-
--- |Part-ordering comparison on lists of partially ordered values, where:
---
---  as==bs  if members of as are all equal to corresponding members of bs
---  as<=bs  if members of as are all less than or equal to corresponding
---          members of bs
---  as>=bs  if members of as are all greater than or equal to corresponding
---          members of bs
---  otherwise as and bs are unrelated
---
-partCompareListPartOrd :: PartCompare a -> [a] -> [a] -> Maybe Ordering
-partCompareListPartOrd cmp as bs = pcomp as bs EQ
-    where
-        pcomp []     []     ordp = Just ordp
-        pcomp (a:as) (b:bs) ordp = case cmp a b of
-            Just rel  -> pcomp1 as bs rel ordp
-            _         -> Nothing
-        pcomp1 as bs ordn EQ   = pcomp as bs ordn
-        pcomp1 as bs EQ   ordp = pcomp as bs ordp
-        pcomp1 as bs ordn ordp =
-            if ordn == ordp then pcomp as bs ordp else Nothing
-
--- |Part-ordering comparison on lists of Ord values, where:
---
---  as==bs  if members of as are all equal to corresponding members of bs
---  as<=bs  if members of as are all less than or equal to corresponding
---          members of bs
---  as>=bs  if members of as are all greater than or equal to corresponding
---          members of bs
---  otherwise as and bs are unrelated
---
-partCompareListOrd :: (Ord a) => [a] -> [a] -> Maybe Ordering
-partCompareListOrd = partCompareListPartOrd (Just `c2` compare)
-    where c2 = (.) . (.)
-
--- |Part-ordering comparison for Maybe values.
-partCompareMaybe :: (Eq a) => Maybe a -> Maybe a -> Maybe Ordering
-partCompareMaybe Nothing  Nothing  = Just EQ
-partCompareMaybe (Just _) Nothing  = Just GT
-partCompareMaybe Nothing  (Just _) = Just LT
-partCompareMaybe (Just a) (Just b) = if a == b then Just EQ else Nothing
-
--- |Part-ordering comparison on lists of Maybe values.
-partCompareListMaybe :: (Eq a) => [Maybe a] -> [Maybe a] -> Maybe Ordering
-partCompareListMaybe = partCompareListPartOrd partCompareMaybe
-
--- |Part-ordering comparison on lists based on subset relationship
-partCompareListSubset :: (Eq a) => [a] -> [a] -> Maybe Ordering
-partCompareListSubset a b
-    | aeqvb     = Just EQ
-    | asubb     = Just LT
-    | bsuba     = Just GT
-    | otherwise = Nothing
-    where
-        asubb = a `subset` b
-        bsuba = b `subset` a
-        aeqvb = asubb && bsuba
-        a `subset` b = and [ ma `elem` b | ma <- a ]
-
-------------------------------------------------------------
---  Test cases
-------------------------------------------------------------
-
-{-
-
-notTrueFalse  = Nothing :: Maybe Bool
-
--- partCompareListOrd
-test01 = partCompareListOrd [1,2,3] [1,2,3] == Just EQ
-test02 = partCompareListOrd [1,2,3] [2,3,4] == Just LT
-test03 = partCompareListOrd [1,2,4] [1,2,3] == Just GT
-test04 = partCompareListOrd [1,2,3] [2,1,3] == Nothing
-
--- partCompareMaybe
-test11 = partCompareMaybe (Just True)  (Just True)  == Just EQ
-test12 = partCompareMaybe (Just True)  (Just False) == Nothing
-test13 = partCompareMaybe notTrueFalse (Just False) == Just LT
-test14 = partCompareMaybe (Just True)  notTrueFalse == Just GT
-test15 = partCompareMaybe notTrueFalse notTrueFalse == Just EQ
-
--- partCompareListMaybe
-test21 = partCompareListMaybe [Just True,Just False]
-                              [Just True,Just False]
-            == Just EQ
-test22 = partCompareListMaybe [Just True,Just False]
-                              [Just True,Just True]
-            == Nothing
-test23 = partCompareListMaybe [Just False,Just True]
-                              [Just False,Just True]
-            == Just EQ
-test24 = partCompareListMaybe [Nothing,   Just True]
-                              [Just False,Just True]
-            == Just LT
-test25 = partCompareListMaybe [Just False,Just True]
-                              [Just False,Nothing]
-            == Just GT
-test26 = partCompareListMaybe [Nothing,   Just True]
-                              [Just False,Nothing]
-            == Nothing
-test27 = partCompareListMaybe [Nothing,Just True]
-                              [Nothing,Nothing]
-            == Just GT
-test28 = partCompareListMaybe [notTrueFalse,notTrueFalse]
-                              [notTrueFalse,notTrueFalse]
-            == Just EQ
-
---  minima, maxima
-test31a = maxima partCompareListMaybe ds1a == ds1b
-test31b = minima partCompareListMaybe ds1a == ds1c
-ds1a =
-    [ [Just 'a',Just 'b',Just 'c']
-    , [Just 'a',Just 'b',Nothing ]
-    , [Just 'a',Nothing ,Just 'c']
-    , [Just 'a',Nothing ,Nothing ]
-    , [Nothing ,Just 'b',Just 'c']
-    , [Nothing ,Just 'b',Nothing ]
-    , [Nothing ,Nothing ,Just 'c']
-    , [Nothing ,Nothing ,Nothing ]
-    ]
-ds1b =
-    [ [Just 'a',Just 'b',Just 'c']
-    ]
-ds1c =
-    [ [Nothing ,Nothing ,Nothing ]
-    ]
-
-test32a = maxima partCompareListMaybe ds2a == ds2b
-test32b = minima partCompareListMaybe ds2a == ds2c
-ds2a =
-    [ [Just 'a',Just 'b',Nothing ]
-    , [Just 'a',Nothing ,Just 'c']
-    , [Just 'a',Nothing ,Nothing ]
-    , [Nothing ,Just 'b',Just 'c']
-    , [Nothing ,Just 'b',Nothing ]
-    , [Nothing ,Nothing ,Just 'c']
-    ]
-ds2b =
-    [ [Just 'a',Just 'b',Nothing ]
-    , [Just 'a',Nothing ,Just 'c']
-    , [Nothing ,Just 'b',Just 'c']
-    ]
-ds2c =
-    [ [Just 'a',Nothing ,Nothing ]
-    , [Nothing ,Just 'b',Nothing ]
-    , [Nothing ,Nothing ,Just 'c']
-    ]
-
-test33a = maxima partCompareListMaybe ds3a == ds3b
-test33b = minima partCompareListMaybe ds3a == ds3c
-ds3a =
-    [ [Just "a1",Just "b1",Just "c1"]
-    , [Just "a2",Just "b2",Nothing  ]
-    , [Just "a3",Nothing  ,Just "c3"]
-    , [Just "a4",Nothing  ,Nothing  ]
-    , [Nothing  ,Just "b5",Just "c5"]
-    , [Nothing  ,Just "b6",Nothing  ]
-    , [Nothing  ,Nothing  ,Just "c7"]
-    ]
-ds3b =
-    [ [Just "a1",Just "b1",Just "c1"]
-    , [Just "a2",Just "b2",Nothing  ]
-    , [Just "a3",Nothing  ,Just "c3"]
-    , [Just "a4",Nothing  ,Nothing  ]
-    , [Nothing  ,Just "b5",Just "c5"]
-    , [Nothing  ,Just "b6",Nothing  ]
-    , [Nothing  ,Nothing  ,Just "c7"]
-    ]
-ds3c =
-    [ [Just "a1",Just "b1",Just "c1"]
-    , [Just "a2",Just "b2",Nothing  ]
-    , [Just "a3",Nothing  ,Just "c3"]
-    , [Just "a4",Nothing  ,Nothing  ]
-    , [Nothing  ,Just "b5",Just "c5"]
-    , [Nothing  ,Just "b6",Nothing  ]
-    , [Nothing  ,Nothing  ,Just "c7"]
-    ]
-
-
-test34a = maxima partCompareListMaybe ds4a == ds4b
-test34b = minima partCompareListMaybe ds4a == ds4c
-ds4a =
-    [ [Just 1, Just 1 ]
-    , [Just 2, Nothing]
-    , [Nothing,Just 3 ]
-    , [Nothing,Nothing]
-    ]
-ds4b =
-    [ [Just 1, Just 1 ]
-    , [Just 2, Nothing]
-    , [Nothing,Just 3 ]
-    ]
-ds4c =
-    [ [Nothing,Nothing]
-    ]
-
--- Check handling of equal values
-test35a = maxima partCompareListMaybe ds5a == ds5b
-test35b = minima partCompareListMaybe ds5a == ds5c
-ds5a =
-    [ [Just 1, Just 1 ]
-    , [Just 2, Nothing]
-    , [Nothing,Just 3 ]
-    , [Nothing,Nothing]
-    , [Just 1, Just 1 ]
-    , [Just 2, Nothing]
-    , [Nothing,Just 3 ]
-    , [Nothing,Nothing]
-    ]
-ds5b =
-    [ [Just 1, Just 1 ]
-    , [Just 2, Nothing]
-    , [Nothing,Just 3 ]
-    ]
-ds5c =
-    [ [Nothing,Nothing]
-    ]
-
--- test case 32 with different ordering of values
-test36a = maxima partCompareListMaybe ds6a == ds6b
-test36b = minima partCompareListMaybe ds6a == ds6c
-ds6a =
-    [ [Just 'a',Just 'b',Nothing ]
-    , [Nothing ,Nothing ,Just 'c']
-    , [Nothing ,Just 'b',Nothing ]
-    , [Nothing ,Just 'b',Just 'c']
-    , [Just 'a',Nothing ,Nothing ]
-    , [Just 'a',Nothing ,Just 'c']
-    ]
-ds6b =
-    [ [Just 'a',Just 'b',Nothing ]
-    , [Nothing ,Just 'b',Just 'c']
-    , [Just 'a',Nothing ,Just 'c']
-    ]
-ds6c =
-    [ [Nothing ,Nothing ,Just 'c']
-    , [Nothing ,Just 'b',Nothing ]
-    , [Just 'a',Nothing ,Nothing ]
-    ]
-
-test = and
-    [ test01, test02, test03, test04
-    , test11, test12, test13, test14, test15
-    , test21, test22, test23, test24, test25, test26, test27, test28
-    , test31a, test31b, test32a, test32b, test33a, test33b
-    , test34a, test34b, test35a, test35b, test36a, test36b
-    ]
-
--}
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/PartOrderedCollection.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: PartOrderedCollection.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.4  2003/11/20 18:35:59  graham
--- Compacted maxima code by use of foldl
--- (per further suggestion by Tom Pledger).
---
--- Revision 1.3  2003/11/20 17:58:09  graham
--- Class-constraint backward chaining: all test cases passed.
---
--- Revision 1.2  2003/11/19 22:13:03  graham
--- Some backward chaining tests passed
---
--- Revision 1.1  2003/11/19 15:21:26  graham
--- Add PartOrderedCollection module
---
− Swish/HaskellUtils/ProcessURI.hs 
@@ -1,342 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ProcessURI.hs,v 1.1 2004/01/22 19:52:27 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ProcessURI
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines a collection of functions for manipulating URIs.
---
---  Functions provided deal with:
---    Validating and parsing URI syntax
---    Separating a fragment from a URI
---    Separating URI into QName and local name
---    Relative URI computations
---
---  The primary reference for URI handling is RFC2396 [1],
---  as updated by RFC 2732 [2].
---  RFC 1808 [3] contains a number of test cases for relative URI handling.
---  Dan Connolly's Python module 'uripath.py' [4] also contains useful details
---  and test cases.
---
---  [1] http://www.ietf.org/rfc/rfc2396.txt
---  [2] http://www.ietf.org/rfc/rfc2732.txt
---  [3] http://www.ietf.org/rfc/rfc1808.txt
---  [4] http://www.w3.org/2000/10/swap/uripath.py
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.ProcessURI
-    ( URI(URI)
-    , isValidURIRef, isAbsoluteURIRef, isAbsoluteURI
-    , parseURIRef, parseAbsoluteURIRef, parseAbsoluteURI
-    , getURIRef, normalizeURI, compareURI, normSeg, normSeg1, mergeSeg
-    , splitURIFragment, makeURIWithFragment -- , splitQName
-    , relativeRefPart, absoluteUriPart
-    )
-where
-
-import Swish.HaskellUtils.ParseURI
-import Swish.HaskellUtils.Parse
--- type Parser a b = Parse.Parser a b
--- isValid         = Parse.isValid
--- parseApply      = Parse.parseApply
-
-
--- Test supplied string for valid URI syntax
-isValidURIRef :: String -> Bool
-isValidURIRef = isValid parseURIRef
-
--- Test supplied string for valid absolute URI reference syntax
-isAbsoluteURIRef :: String -> Bool
-isAbsoluteURIRef = isValid parseAbsoluteURIRef
-
--- Test supplied string for valid absolute URI syntax
-isAbsoluteURI :: String -> Bool
-isAbsoluteURI = isValid parseAbsoluteURI
-
--- URI parser (see Parse and ParseURI modules)
-parseURIRef :: Parser Char String
-parseURIRef = uriReference `parseApply` uriToString
-
--- Absolute URI reference parser (see Parse module)
-parseAbsoluteURIRef :: Parser Char String
-parseAbsoluteURIRef = absoluteUriReference `parseApply` uriToString
-
--- Absolute URI parser (see Parse module)
-parseAbsoluteURI :: Parser Char String
-parseAbsoluteURI = absoluteUri `parseApply` uriToString
-
--- Parse and return URI reference as URI value
-getURIRef :: String -> URI
-getURIRef s = extractURIRef (uriReference s)
-    where
-    extractURIRef [(u,"")] = u
-    extractURIRef [(_,_)]  = ( URI "" "" ["<invalid URI>"] "" "" )
-    extractURIRef _        = ( URI "" "" ["<ambiguous URI>"] "" "" )
-
--- Normalize URI string
-normalizeURI :: String -> String
-normalizeURI str = uriToString (URI sc au (normSeg se) qu fr)
-    where
-    URI sc au se qu fr = getURIRef str
-
--- Compare two URIs
--- Takes account of normalizations that can be applied to all URIs
--- (2003-02-20, currently subject to W3C TAG debate)
-compareURI :: String -> String -> Bool
-compareURI u1 u2 = ( u1 == u2 )
-
--- Separate URI-with-fragment into URI and fragment ID
-splitURIFragment :: String -> ( String, Maybe String )
-    -- splitURIFragment "http://example.org/aaa#bbb" =
-    --     ("http://example.org/aaa",Just "bbb")
-    -- splitURIFragment "http://example.org/aaa" =
-    --     ("http://example.org/aaa",Nothing)
-splitURIFragment inp =
-    case (uriReference inp) of
-        [(URI s a p q f,"")] -> (uriToString (URI s a p q ""),pickFrag f)
-        _ -> error ("splitURIFragment, Invalid URI: "++inp)
-    where
-        pickFrag ('#':f) = Just f
-        pickFrag _       = Nothing
-
--- Construct URI-with-fragment using URI and supplied fragment id
-makeURIWithFragment :: String -> Maybe String -> String
-    -- makeURIWithFragment "http://example.org/aaa" (Just "fff") =
-    --     "http://example.org/aaa#fff"
-    -- makeURIWithFragment "http://example.org/aaa#bbb" (Just "fff") =
-    --     "http://example.org/aaa#fff"
-    -- makeURIWithFragment "http://example.org/aaa" Nothing
-    --     "http://example.org/aaa"
-    -- makeURIWithFragment "http://example.org/aaa#bbb" Nothing
-    --     "http://example.org/aaa"
-makeURIWithFragment base frag =
-    case frag of
-        Just f  -> b ++ "#" ++ f
-        Nothing -> b
-        where
-            (b,_) = splitURIFragment base
-
--- Separate URI into QName URI and local name
-splitQName :: String -> ( String, String )
-    -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
-    -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
-    -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
-splitQName qn = splitAt (scanQName qn (-1) 0) qn
-
--- helper function for splitQName
--- Takes 3 arguments:
---   QName to scan
---   index of last name-start char, or (-1)
---   number of characters scanned so far
--- Returns index of start of name, or length of list
---
-scanQName :: String -> Int -> Int -> Int
-scanQName (nextch:more) (-1) nc
-    | isNameStartChar nextch  = scanQName more nc   (nc+1)
-    | otherwise               = scanQName more (-1) (nc+1)
-scanQName (nextch:more) ns nc
-    | not (isNameChar nextch) = scanQName more (-1) (nc+1)
-    | otherwise               = scanQName more ns   (nc+1)
-scanQName "" (-1) nc = nc
-scanQName "" ns   _  = ns
-
--- Definitions here per XML namespaces, NCName production,
--- restricted to characters used in URIs.
--- cf. http://www.w3.org/TR/REC-xml-names/
-isNameStartChar c = ( isAlpha c ) || ( c == '_' )
-isNameChar      c = ( isAlpha c ) || ( isDigit c ) || ( any (==c) ".-_" )
-
--- Get reference relative to given base
-relativeRefPart :: String -> String -> String
-    -- relativeRefPart "base:" "base:relativeRef" = "relativeRef"
-    -- relativeRefPart "base:" "another:URI"      = "another:URI"
-relativeRefPart base full =
-    uriToString ( relPartRef ( getURIRef base ) ( getURIRef full ) )
-    where
-    relPartRef u1@(URI sc1 au1 se1 _ _) u2@( URI sc2 au2 se2 qu2 fr2 )
-        | sc1 /= sc2 = URI sc2 au2 (normSeg se2) qu2 fr2    -- different schemes
-        | opaque au1 = URI "" au2 (normSeg se2) qu2 fr2     -- same scheme, base is opaque
-        | au1 /= au2 = URI "" au2 (normSeg se2) qu2 fr2     -- same scheme, different authority
-        | otherwise  = URI "" "" (relPath (normSeg se1) (normSeg se2) ) qu2 fr2
-    -- If paths share a leading segment (other than "/") then compute a path relative
-    -- to the base URI, otherwise return a root-relative path
-    relPath s1 []    = ["/"]
-    relPath [] s2    = s2
-    relPath ("/":s1h:s1t) s2@("/":s2h:s2t)
-        | s1h == s2h = relPartSeg s1t s2t
-        | otherwise  = s2
-    relPath (s1h:s1t) s2@(s2h:s2t)
-        | s1h == s2h = relPartSeg s1t s2t
-        | otherwise  = s2
-    {- relPath s1@(_:_) s2@(_:_) = relPartSeg s1 s2 [[[REDUNDANT?]]] -}
-    -- Path-segment relative to base:
-    -- (An alternative would be descendent relative to base, otherwise relative to root)
-    --   relPartSeg a/b a/c -> c        (case 1:  common leading segments)
-    --   relPartSeg a/b a/  -> ./       (case 1a: identical paths with empty name)
-    --   relPartSeg a   b/c -> b/c      (case 2:  all base path segments used)
-    --   relPartSeg b   c   -> c        (case 2)
-    --   relPartSeg a   c/  -> c/       (case 2)
-    --   relPartSeg ""  c   -> c        (case 2)
-    --   relPartSeg a ""    -> ""       (case 2)
-    --   relPartSeg a   c:d -> ./c:d    (case 2a: bare name looks like URI
-    --   relPartSeg a/b c   -> ../c     (case 3: unused base path segments)
-    --   relPartSeg a/b ""  -> ../      (case 3)
-    --   relPartSeg a/  c   -> ../c     (case 3)
-    --   relPartSeg a/  ""  -> ../      (case 3)
-    -- NOTE the last element of the path segment lists are always the "name" component,
-    -- and is present as an empty string if the path ends with a '/' character
-    relPartSeg [_] [""]    = ["./",""]                  -- Case 1a
-    relPartSeg [_] [st]
-        | looksLikeURI st  = ["./",st]                  -- Case 2a
-        | otherwise        = [st]                       -- Case 2
-    relPartSeg [_] s2      = s2                         -- Case 2
-    relPartSeg s1  [s2t]   = difPartSeg s1 [s2t]        -- Case 3  (this test should be redundant)
-    relPartSeg s1@(s1h:s1t) s2@(s2h:s2t)
-        | s1h == s2h = relPartSeg s1t s2t               -- Case 1
-        | otherwise  = difPartSeg s1 s2                 -- Case 2 or 3 ...
-    difPartSeg [_]     s2  = s2                         -- Case 2  (final base segment is ignored)
-    difPartSeg (_:s1t) s2  = "../":(difPartSeg s1t s2)  -- Case 3
-
--- Get absolute URI given base and relative reference
--- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.
--- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
-absoluteUriPart :: String -> String -> String
-    -- absoluteUriPart "base:" "relativeRef" = "base:relativeRef"
-    -- absoluteUriPart "base:" "another:URI" = "another:URI"
-absoluteUriPart base rel =
-    uriToString ( joinRef ( getURIRef base ) ( getURIRef rel ) )
-    where
-    joinRef u1@(URI sc1 au1 se1 _ _) u2@( URI sc2 au2 se2 qu2 fr2 )
-        -- non-validating case here?  (See RFC2396bis section 5.2)
-        | sc2 /= ""     = u2
-        | opaque au1    = URI sc1 au2 se2 qu2 fr2                       -- Base not relative
-        | au2 /= ""     = URI sc1 au2 se2 qu2 fr2
-        | se2 == []     = if qu2 == "" then URI "" "" [] "" fr2         -- Same document
-                                       else URI sc1 au1 se1 qu2 fr2     -- Base document
-        | otherwise     = URI sc1 au1 ( mergeSeg se1 se2 ) qu2 fr2
-
--- Test authority string for opaque form (non-null and not starting with '/')
-opaque :: String -> Bool
-opaque ""      = False
-opaque ('/':_) = False
-opaque _       = True
-
--- Merge segment se2 with base segment se1
-mergeSeg :: [String] -> [String] -> [String]
-mergeSeg _ s2@("/":se2) = normSeg s2
-mergeSeg [] se2         = normSeg ("/":se2)
-mergeSeg se1 se2        = normSeg ( (init se1) ++ se2 )
-
--- Normalize ./ and ../ in segment list:
--- Don't touch leading "/"
--- Don't allow "../" to cancel another "../"
--- Leave bare "./"
--- Remove any trailing "./"
-normSeg :: [String] -> [String]
-normSeg ("/":st)      = "/":(normSeg1 st)
-normSeg st            = normSeg1 st
-
-normSeg1 []           = []
-normSeg1 ["./"]       = ["./"]
-normSeg1 ["."]        = ["./",""]                      -- trailing '.' is treated as './'
-normSeg1 [".."]       = ["../",""]                     -- trailing '..' is treated as '../'
-normSeg1 p@["./",st]
-    | looksLikeURI st = p
-    | otherwise       = [st]
-normSeg1 ("./":st)    = normSeg1 st
-normSeg1 (s1:st)      = normSeg2 (s1:(normSeg1 st))    -- TEST CASE:  a/b/../../c
-
-normSeg2 :: [String] -> [String]
-normSeg2 s@("../":"../":st) = s
-normSeg2 ["./","../"] = ["./"]
-normSeg2 (_:"../":st) = st
-normSeg2 [sh,"./"]    = [sh]
-normSeg2 (sh:"./":st) = sh:st
-normSeg2 ("./":st)    = st
-normSeg2 st           = st
-
--- Test if string looks like a URI, by virtue of starting with a 'name:'
-looksLikeURI :: String -> Bool
-looksLikeURI name = not ( null ( relSegmentWithColon name ) )
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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.
---
---  Foobar 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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ProcessURI.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ProcessURI.hs,v $
--- Revision 1.1  2004/01/22 19:52:27  graham
--- Rename module URI to avoid awkward clash with Haskell libraries
---
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.12  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.11  2003/09/24 13:35:44  graham
--- QName splitting moved from URI module to QName module
---
--- Revision 1.10  2003/06/03 19:24:13  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.9  2003/05/28 19:57:50  graham
--- Adjusting code to compile with GHC
---
--- Revision 1.8  2003/03/05 22:16:23  graham
--- URI code passes all unit tests
---
--- Revision 1.7  2003/03/05 14:47:45  graham
--- Relative URI code complete, not tested
--- Fixed a URI parser bug
---
--- Revision 1.6  2003/02/28 14:02:52  graham
--- A few new test cases
---
--- Revision 1.5  2003/02/27 23:33:54  graham
--- QName splitting tested OK
---
--- Revision 1.4  2003/02/27 18:48:05  graham
--- Fix URI parser bug.
--- Add more URI parser test cases.
---
--- Revision 1.3  2003/02/27 08:59:53  graham
--- Separate URI parser from main URI module
---
--- Revision 1.2  2003/02/27 00:30:14  graham
--- Syntax code nearly complete, untested
---
--- Revision 1.1  2003/02/20 19:45:07  graham
--- Add URI module and unit tests.
--- Code incomplete.
---
− Swish/HaskellUtils/QName.hs 
@@ -1,177 +0,0 @@---------------------------------------------------------------------------------
---  $Id: QName.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  QName
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines an algebraic datatype for qualified names (QNames).
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.QName
-    ( QName(..) -- , maybeQnEq
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-where
-
-import Data.Char
-    ( isAlpha, isAlphaNum )
-
-------------------------------------------------------------
---  Qualified name
-------------------------------------------------------------
---
---  cf. http://www.w3.org/TR/REC-xml-names/
-
-data QName = QName { qnNsuri, qnLocal :: String }
-
-newQName :: String -> String -> QName
-newQName ns ln = QName ns ln
-
-qnameFromPair :: (String,String) -> QName
-qnameFromPair (ns,ln) = QName ns ln
-
-qnameFromURI :: String -> QName
-qnameFromURI = qnameFromPair . splitURI
-
-getNamespace :: QName -> String
-getNamespace qn = qnNsuri qn
-
-getLocalName :: QName -> String
-getLocalName qn = qnLocal qn
-
-getQNameURI :: QName -> String
-getQNameURI (QName ns ln) = ns++ln
-
-instance Eq QName where
-    (==) = qnEq
-
-instance Ord QName where
-    (QName u1 l1) <= (QName u2 l2) =
-        if ( up1 /= up2) then (up1 <= up2) else ((ur1++l1) <= (ur2++l2))
-        where
-            n   = min (length u1) (length u2)
-            (up1,ur1) = splitAt n u1
-            (up2,ur2) = splitAt n u2
-
-instance Show QName where
-    show (QName ns ln) = "<" ++ ns ++ ln ++ ">"
-
---  Original used comparison of concatenated strings,
---  but that was very inefficient.  This version does the
---  comparison without constructing new values
-qnEq :: QName -> QName -> Bool
-qnEq (QName ns1 ln1) (QName ns2 ln2) = qnEq1 ns1 ns2 ln1 ln2
-
-qnEq1 (c1:ns1) (c2:ns2)  ln1 ln2   = (c1==c2) && (qnEq1 ns1 ns2 ln1 ln2)
-qnEq1 []  ns2  ln1@(_:_) ln2       = qnEq1 ln1 ns2 []  ln2
-qnEq1 ns1 []   ln1       ln2@(_:_) = qnEq1 ns1 ln2 ln1 []
-qnEq1 []  []   []        []        = True
-qnEq1 _   _    _         _         = False
-
-{-
---  Define equality of (Maybe QName)
-maybeQnEq :: (Maybe QName) -> (Maybe QName) -> Bool
-maybeQnEq Nothing   Nothing   = True
-maybeQnEq (Just q1) (Just q2) = q1 == q2
-maybeQnEq _         _         = False
--}
-
--- Separate URI string into namespace URI and local name
-splitURI :: String -> ( String, String )
-  -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
-  -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
-  -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
-splitURI qn = splitAt (scanURI qn (-1) 0) qn
-
--- helper function for splitQName
--- Takes 3 arguments:
---   QName to scan
---   index of last name-start char, or (-1)
---   number of characters scanned so far
--- Returns index of start of name, or length of list
---
-scanURI :: String -> Int -> Int -> Int
-scanURI (nextch:more) (-1) nc
-    | isNameStartChar nextch  = scanURI more nc   (nc+1)
-    | otherwise               = scanURI more (-1) (nc+1)
-scanURI (nextch:more) ns nc
-    | not (isNameChar nextch) = scanURI more (-1) (nc+1)
-    | otherwise               = scanURI more ns   (nc+1)
-scanURI "" (-1) nc = nc
-scanURI "" ns   _  = ns
-
-
---- Definitions here per XML namespaces, NCName production,
--- restricted to characters used in URIs.
--- cf. http://www.w3.org/TR/REC-xml-names/
--isNameStartChar :: Char -> Bool-isNameStartChar c = ( isAlpha c )    || ( c == '_' )
--isNameChar :: Char -> Bool-isNameChar      c = ( isAlphaNum c ) || ( any (==c) ".-_" )
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/QName.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: QName.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.5  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.4  2003/10/24 21:05:09  graham
--- Working on datatype inference.  Most of the variable binding logic
--- is done, but the rule structure still needs to be worked out to support
--- forward and backward chaining through the same rule.
---
--- Revision 1.3  2003/09/30 20:02:40  graham
--- Proof mechanisms now use scoped names and rulesets.
--- Move some functionality between modules so that RDFProofCheck
--- contains less generic code.
---
--- Revision 1.2  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.1  2003/09/24 12:51:00  graham
--- Add separate QName module and test suite
---
− Swish/HaskellUtils/QNameTest.hs 
@@ -1,399 +0,0 @@---------------------------------------------------------------------------------
---  $Id: QNameTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  QNameTest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines test cases for QName data
---
---------------------------------------------------------------------------------
-
--- WNH module Swish.HaskellUtils.QNameTest where
-
--- module Main where--import System.IO
-    ( Handle, IOMode(WriteMode)
-    , openFile, hClose, hPutStr, hPutStrLn
-    )
-
-import Data.Maybe
-    ( fromJust )
-
-import Test.HUnit
-    ( Test(TestCase,TestList,TestLabel)
-    , assertBool, assertEqual, assertString
-    , runTestTT, runTestText, putTextToHandle
-    )
-
-import Swish.HaskellUtils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
-    )
-
----------------------------------------------------------------
---  Define some common values
-------------------------------------------------------------
-
-base1  = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-base2  = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-base3  = "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4  = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-base5  = "http://id.ninebynine.org/wip/2003/test/graph5/"
-
-qb1s1  = QName base1 "s1"
-qb2s2  = QName base2 "s2"
-qb3s3  = QName base3 "s3"
-qb3    = QName base3 ""
-qb3bm  = QName base3 "basemore"
-qb4m   = QName base4 "more"
-
-qb5    = QName base5 ""
-qb5s5  = QName base5 "s5"
-
-qb1st1 = QName base1 "st1"
-qb2st2 = QName base2 "st2"
-qb3st3 = QName base3 "st3"
-
-
-------------------------------------------------------------
---  QName equality tests
-------------------------------------------------------------
-
-testQNameEq :: String -> Bool -> QName -> QName -> Test
-testQNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )
-
-qnlist =
-  [ ("qb1s1", qb1s1)
-  , ("qb2s2", qb2s2)
-  , ("qb3s3", qb3s3)
-  , ("qb3",   qb3)
-  , ("qb3bm", qb3bm)
-  , ("qb4m",  qb4m)
-  , ("qb5",   qb5)
-  , ("qb5s5", qb5s5)
-  , ("qb1st1",qb1st1)
-  , ("qb2st2",qb2st2)
-  , ("qb3st3",qb3st3)
-  ]
-
-qneqlist =
-  [ ("qb3bm","qb4m")
-  ]
-
-testQNameEqSuite = TestList
-  [ testQNameEq (testLab l1 l2) (testEq  l1 l2) n1 n2
-      | (l1,n1) <- qnlist , (l2,n2) <- qnlist ]
-    where
-    testLab l1 l2 = l1 ++ "-" ++ l2
-    testEq  l1 l2 = (l1 == l2)        ||
-            (l1,l2) `elem` qneqlist ||
-            (l2,l1) `elem` qneqlist
-
-------------------------------------------------------------
---  Alternative constructors
-------------------------------------------------------------
-
-nq1 = newQName base1 "s1"
-nq2 = newQName base1 "s2"
-
-testnq01 = testQNameEq "testnq01" True  nq1 qb1s1
-testnq02 = testQNameEq "testnq02" False nq2 qb1s1
-
-qp1 = qnameFromPair (base1,"s1")
-qp2 = qnameFromPair (base1,"s2")
-
-testqp01 = testQNameEq "testqp01" True  qp1 qb1s1
-testqp02 = testQNameEq "testqp02" False qp2 qb1s1
-
-qu1 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
-qu2 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
-qu3 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph3/node"
-qu4 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/"
-qu5 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/s5"
-
-testqu01 = testQNameEq "testqu01" True qb1s1 qu1
-testqu02 = testQNameEq "testqu02" True qb2s2 qu2
-testqu03 = testQNameEq "testqu03" True qb3   qu3
-testqu04 = testQNameEq "testqu04" True qb5   qu4
-testqu05 = testQNameEq "testqu05" True qb5s5 qu5
-
-testMakeQNameSuite = TestList
-  [ testnq01, testnq02
-  , testqp01, testqp02
-  , testqu01, testqu02, testqu03, testqu04, testqu05
-  ]
-
-
-------------------------------------------------------------
---  Extract components
-------------------------------------------------------------
-
-testStringEq :: String -> String -> String -> Test
-testStringEq lab s1 s2 =
-    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )
-
-testGetNamespace01 = testStringEq "testGetNamespace01"
-    "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-    (getNamespace qb1s1)
-
-testGetNamespace02 = testStringEq "testGetNamespace02"
-    "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-    (getNamespace qb2s2)
-
-testGetNamespace03 = testStringEq "testGetNamespace03"
-    "http://id.ninebynine.org/wip/2003/test/graph3/node"
-    (getNamespace qb3s3)
-
-testGetNamespace04 = testStringEq "testGetNamespace04"
-    "http://id.ninebynine.org/wip/2003/test/graph3/node"
-    (getNamespace qb3)
-
-testGetLocalName01 = testStringEq "testGetLocalName01"
-    "s1"
-    (getLocalName qb1s1)
-
-testGetLocalName02 = testStringEq "testGetLocalName02"
-    "s2"
-    (getLocalName qb2s2)
-
-testGetLocalName03 = testStringEq "testGetLocalName03"
-    "s3"
-    (getLocalName qb3s3)
-
-testGetLocalName04 = testStringEq "testGetLocalName04"
-    ""
-    (getLocalName qb3)
-
-testGetQNameURI01 = testStringEq "testGetQNameURI01"
-    "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
-    (getQNameURI qb1s1)
-
-testGetQNameURI02 = testStringEq "testGetQNameURI02"
-    "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
-    (getQNameURI qb2s2)
-
-testGetQNameURI03 = testStringEq "testGetQNameURI03"
-    "http://id.ninebynine.org/wip/2003/test/graph3/nodes3"
-    (getQNameURI qb3s3)
-
-testGetQNameURI04 = testStringEq "testGetQNameURI04"
-    "http://id.ninebynine.org/wip/2003/test/graph3/node"
-    (getQNameURI qb3)
-
-
-testPartQNameSuite = TestList
-  [ testGetNamespace01, testGetNamespace02, testGetNamespace03
-  , testGetNamespace04
-  , testGetLocalName01, testGetLocalName02, testGetLocalName03
-  , testGetLocalName04
-  , testGetQNameURI01,  testGetQNameURI02,  testGetQNameURI03
-  , testGetQNameURI04
-  ]
-
-------------------------------------------------------------
---  Maybe Qname comparison
-------------------------------------------------------------
-
-testMaybeQNameEq :: String -> Bool -> (Maybe QName) -> (Maybe QName) -> Test
-testMaybeQNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) )
-
-testMaybeQNameEq01 = testMaybeQNameEq "testMaybeQNameEq01" True
-    (Just qb1s1) (Just qb1s1)
-testMaybeQNameEq02 = testMaybeQNameEq "testMaybeQNameEq02" False
-    (Just qb1s1) (Just qb2s2)
-testMaybeQNameEq03 = testMaybeQNameEq "testMaybeQNameEq03" False
-    (Just qb1s1) Nothing
-testMaybeQNameEq04 = testMaybeQNameEq "testMaybeQNameEq04" False
-    Nothing (Just qb1s1)
-testMaybeQNameEq05 = testMaybeQNameEq "testMaybeQNameEq05" True
-    Nothing Nothing
-
-testMaybeQNameEqSuite = TestList
-  [ testMaybeQNameEq01
-  , testMaybeQNameEq02
-  , testMaybeQNameEq03
-  , testMaybeQNameEq04
-  , testMaybeQNameEq05
-  ]
-
-------------------------------------------------------------
---  QName ordering
-------------------------------------------------------------
-
-testQNameLe :: String -> Bool -> QName -> QName -> Test
-testQNameLe lab le n1 n2 =
-    TestCase ( assertEqual ("testQNameLe:"++lab) le (n1<=n2) )
-
-testQNameLe01 = testQNameLe "testQNameLe01" True  qb3bm qb4m
-testQNameLe02 = testQNameLe "testQNameLe02" True  qb4m  qb3bm
-testQNameLe03 = testQNameLe "testQNameLe03" True  qb1s1 qb2s2
-testQNameLe04 = testQNameLe "testQNameLe04" False qb2s2 qb1s1
-
-testQNameLeSuite = TestList
-  [ testQNameLe01
-  , testQNameLe02
-  , testQNameLe03
-  , testQNameLe04
-  ]
-
-------------------------------------------------------------
---  Show QName
-------------------------------------------------------------
-
-testShowQName01 = testStringEq "testShowQName01"
-    "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"
-    (show qb1s1)
-
-testShowQName02 = testStringEq "testShowQName02"
-    "<http://id.ninebynine.org/wip/2003/test/graph2/node/s2>"
-    (show qb2s2)
-
-testShowQName03 = testStringEq "testShowQName03"
-    "<http://id.ninebynine.org/wip/2003/test/graph3/node>"
-    (show qb3)
-
-testShowQName04 = testStringEq "testShowQName04"
-    "<http://id.ninebynine.org/wip/2003/test/graph5/>"
-    (show qb5)
-
-testShowQNameSuite = TestList
-  [ testShowQName01
-  , testShowQName02
-  , testShowQName03
-  , testShowQName04
-  ]
-
-
-------------------------------------------------------------
---  Split URI string into QName parts
-------------------------------------------------------------
-
--- splitURI :: String -> ( String, String )
-    -- splitURI "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
-    -- splitURI "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
-    -- splitURI "http://example.org/aaa/"    = ("http://example.org/aaa/","")
-
-testSplitURI :: String -> String -> ( String, String ) -> Test
-testSplitURI label input ( main, local ) =
-    TestCase ( assertEqual label ( main, local ) ( splitURI input ) )
-
-testSplitURI01 = testSplitURI "testSplitURI01"
-                    "http://example.org/aaa#bbb"
-                    ( "http://example.org/aaa#", "bbb" )
-testSplitURI02 = testSplitURI "testSplitURI02"
-                    "http://example.org/aaa/bbb"
-                    ( "http://example.org/aaa/", "bbb" )
-testSplitURI03 = testSplitURI "testSplitURI03"
-                    "http://example.org/aaa#"
-                    ( "http://example.org/aaa#", "" )
-testSplitURI04 = testSplitURI "testSplitURI04"
-                    "http://example.org/aaa/"
-                    ( "http://example.org/aaa/", "" )
-testSplitURI05 = testSplitURI "testSplitURI05"
-                    "//example.org/aaa#bbb"
-                    ( "//example.org/aaa#", "bbb" )
-testSplitURI06 = testSplitURI "testSplitURI06"
-                    "aaa/bbb"
-                    ( "aaa/", "bbb" )
-testSplitURI07 = testSplitURI "testSplitURI07"
-                    "aaa/bbb/"
-                    ( "aaa/bbb/", "" )
--- Thanks to Ian Dickinson of the HP Jena team for spotting this one:
--- So what *is* the correct split here?
-testSplitURI08 = testSplitURI "testSplitURI08"
-                    "mortal"
-                    ( "", "mortal" )
-
-testSplitURISuite = TestList
-  [
-    testSplitURI01, testSplitURI02, testSplitURI03, testSplitURI04,
-    testSplitURI05, testSplitURI06, testSplitURI07, testSplitURI08
-  ]
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allTests = TestList
-  [ testQNameEqSuite
-  , testMakeQNameSuite
-  , testPartQNameSuite
-  , testMaybeQNameEqSuite
-  , testQNameLeSuite
-  , testShowQNameSuite
-  , testSplitURISuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/QNameTest.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: QNameTest.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.5  2004/01/07 19:49:13  graham
--- Reorganized RDFLabel details to eliminate separate language field,
--- and to use ScopedName rather than QName.
--- Removed some duplicated functions from module Namespace.
---
--- Revision 1.4  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.3  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.2  2003/09/24 13:36:42  graham
--- QName handling separated from RDFGraph module, and
--- QName splitting moved from URI module to QName module.
---
--- Revision 1.1  2003/09/24 12:51:00  graham
--- Add separate QName module and test suite
---
− Swish/HaskellUtils/ShowM.hs 
@@ -1,95 +0,0 @@---------------------------------------------------------------------------------
---  $Id: ShowM.hs,v 1.1 2004/02/11 16:31:01 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  ShowM
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module defines an extension of the Show class for displaying
---  multi-line values.  It serves the following purposes:
---  (1) provides a method with greater layout control of multiline values,
---  (2) provides a possibility to override the default Show behaviour
---      for programs that use the extended ShowM interface, and
---  (3) uses a ShowS intermediate value to avoid unnecessary
---      concatenation of long strings.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.ShowM
-    ( ShowM(..), showm
-    )
-where
-
-------------------------------------------------------------
---  ShowM framework
-------------------------------------------------------------
-
--- |ShowM is a type class for values that may be formatted in
---  multi-line displays.
-class (Show sh) => ShowM sh where
-    -- |Multi-line value display method
-    --  Create a multiline displayable form of a value, returned
-    --  as a ShowS value.  The default implementation behaves just
-    --  like a normal instance of Show.
-    --
-    --  This function is intended to allow the calling function some control
-    --  of multiline displays by providing:
-    --  (1) the first line of the value is not preceded by any text, so
-    --      it may be appended to some preceding text on the same line,
-    --  (2) the supplied line break string is used to separate lines of the
-    --      formatted text, and may include any desired indentation, and
-    --  (3) no newline is output following the final line of text.
-    showms :: String -> sh -> ShowS
-    showms linebreak val = shows val
-
--- |showm
---  Return a string representation of a ShowM value.
-showm :: (ShowM sh) => String -> sh -> String
-showm linebreak val = showms linebreak val ""
-
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/ShowM.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: ShowM.hs,v $
--- Revision 1.1  2004/02/11 16:31:01  graham
--- Move ShowM to HaskellUtils directory.
---
--- Revision 1.2  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.1  2003/06/25 21:20:12  graham
--- Add ShowM class and RDF graph instance to CVS.
--- This is part of reworking N3 formatting logic to support proof display,
--- and other multiline display requirements.
---
− Swish/HaskellUtils/TestHelpers.hs 
@@ -1,223 +0,0 @@---------------------------------------------------------------------------------
---  $Id: TestHelpers.hs,v 1.2 2004/01/13 12:18:34 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  TestHelpers
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module contains test case helper functions, providing a range of
---  commonly-used test cases.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.TestHelpers
-    ( test, testEq, testLe, testGe, testElem
-    , testJust, testNothing
-    , testEqv, testEqv2, testHasEqv, testMaybeEqv
-    )
-where
-
-import Swish.HaskellUtils.ListHelpers
-    ( equiv )
-
-import Test.HUnit
-    ( Test(TestCase,TestList)
-    , Assertion
-    , assertBool, assertEqual, assertFailure
-    , runTestTT
-    )
-
-import Control.Monad
-    ( unless )
-
-import Data.Maybe
-    ( isJust )
-
-
-------------------------------------------------------------
---  Test case helpers
-------------------------------------------------------------
-
-assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
-assertMember preface item list =
-  unless (item `elem` list) (assertFailure msg)
-  where msg = (if null preface then "" else preface ++ "\n") ++
-             "expected: " ++ show item ++ "\nin list: " ++ show list
-
-test :: String -> Bool -> Test
-test lab bv =
-    TestCase ( assertBool ("test:"++lab) bv )
-
-testEq :: (Eq a, Show a) => String -> a -> a -> Test
-testEq lab a1 a2 =
-    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
-
-testLe :: (Ord a, Show a) => String -> a -> a -> Test
-testLe lab a1 a2 =
-    TestCase ( assertBool ("testLe:"++lab++vals) (a1<=a2) )
-    where
-        vals = ", fail: "++show a1++" <= "++show a2
-
-testGe :: (Ord a, Show a) => String -> a -> a -> Test
-testGe lab a1 a2 =
-    TestCase ( assertBool ("testGe:"++lab++vals) (a1>=a2) )
-    where
-        vals = ", fail: "++show a1++" >= "++show a2
-
--- Test for Just x or Nothing
-
-testJust :: String -> Maybe a -> Test
-testJust lab av =
-    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
-
-testNothing :: String -> Maybe a -> Test
-testNothing lab av =
-    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
-
--- Test for list membership
-
-testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
-testElem lab a1 as =
-    TestCase ( assertMember ("testElem:"++lab) a1 as )
-
--- Compare lists and lists of lists and Maybe lists for set equivalence:
-
-data ListTest a = ListTest [a]
-
-instance (Eq a) => Eq (ListTest a) where
-    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
-
-instance (Show a) => Show (ListTest a) where
-    show (ListTest a) = show a
-
-data MaybeListTest a = MaybeListTest (Maybe [a])
-
-instance (Eq a) => Eq (MaybeListTest a) where
-    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
-    MaybeListTest Nothing   == MaybeListTest Nothing   = True
-    _                       == _                       = False
-
-instance (Show a) => Show (MaybeListTest a) where
-    show (MaybeListTest a) = show a
-
-testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
-testEqv lab a1 a2 =
-    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
-
-testEqv2 :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
-testEqv2 lab a1 a2 =
-    TestCase ( assertEqual ("testEqv2:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest $ map ListTest a1
-        ma2 = ListTest $ map ListTest a2
-
-testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
-testHasEqv lab a1 a2 =
-    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = ListTest a1
-        ma2 = map ListTest a2
-
-testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
-testMaybeEqv lab a1 a2 =
-    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
-    where
-        ma1 = (MaybeListTest a1)
-        ma2 = (MaybeListTest a2)
-
-------------------------------------------------------------
---  Test suites for the above
-------------------------------------------------------------
-
-testSuccessSuite = TestList
-    [ test          "01" True
-    , testEq        "02" 2 2
-    , testLe        "03" 1 2
-    , testLe        "04" 2 2
-    , testGe        "05" 3 2
-    , testGe        "07" 2 2
-    , testJust      "08" (Just "08")
-    , testNothing   "09" (Nothing :: Maybe String)
-    , testElem      "10" 'b' "abc"
-    , testEqv       "11" "abc" "bca"
-    , testEqv       "12" "abc" "bbccaa"
-    , testEqv2      "13" ["abc","def","ghi"] ["fed","ghi","bca"]
-    , testHasEqv    "14" "abc"               ["fed","ghi","bca"]
-    , testHasEqv    "15" "ghi"               ["fed","ghi","bca"]
-    , testHasEqv    "16" "def"               ["fed","ghi","bca"]
-    , testMaybeEqv  "17" (Just "abc") (Just "bca")
-    , testMaybeEqv  "18" Nothing      (Nothing :: Maybe String)
-    ]
-
--- All of these tests should be failures:
--- Look for number of failures == total number of tests
-testFailureSuite = TestList
-    [ test          "01" False
-    , testEq        "02" 2 22
-    , testLe        "03" 2 1
-    , testGe        "04" 2 3
-    , testJust      "05" (Nothing :: Maybe String)
-    , testNothing   "06" (Just "09")
-    , testElem      "07" 'd' "abc"
-    , testEqv       "08" "abd" "bca"
-    , testEqv2      "09" ["abd","def","ghi"] ["fed","ghi","bca"]
-    , testHasEqv    "10" "abd"               ["fed","ghi","bca"]
-    , testMaybeEqv  "11" (Just "abc") (Just "bda")
-    , testMaybeEqv  "12" Nothing      (Just "bda")
-    ]
-
-
-------------------------------------------------------------
---  All tests
-------------------------------------------------------------
-
-allSuccessTests = TestList
-    [ testSuccessSuite
-    ]
-
-allFailureTests = TestList
-    [ testFailureSuite
-    ]
-
-mainS = runTestTT allSuccessTests
-mainF = runTestTT allFailureTests
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/TestHelpers.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: TestHelpers.hs,v $
--- Revision 1.2  2004/01/13 12:18:34  graham
--- Clean up test case helpers module.
---
--- Revision 1.1.1.1  2004/01/13 12:15:56  graham
--- Fix up name of HaskellUtils project
− Swish/HaskellUtils/TraceHelpers.hs 
@@ -1,71 +0,0 @@---------------------------------------------------------------------------------
---  $Id: TraceHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  TraceHelpers
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98
---
---  This module provides access to tracing functions from the pre-2003
---  Hugs trace module.  Over time, it may accumulate other tracing
---  functions that I find useful.
---
---------------------------------------------------------------------------------
-
-module Swish.HaskellUtils.TraceHelpers
-    ( trace, traceShow
-    )
-where
-
-import Debug.Trace
-    ( trace )
-
-------------------------------------------------------------
---  traceShow function from older Hugs trace module
-------------------------------------------------------------
-
-traceShow :: Show a => String -> a -> a
-traceShow msg x = trace (msg ++ show x) x
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/TraceHelpers.hs,v $
--- $Author: graham $
--- $Revision: 1.1 $
--- $Log: TraceHelpers.hs,v $
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.1  2003/12/20 12:02:08  graham
--- Introduced new TraceHelpers module for Hugs-2003 compatibility.
---
--- Revision 1.3  2003/12/18 18:29:03  graham
--- ??????
---
− Swish/HaskellUtils/URITest.hs 
@@ -1,1092 +0,0 @@---------------------------------------------------------------------------------
---  $Id: URITest.hs,v 1.2 2004/01/22 19:52:27 graham Exp $
---
---  Copyright (c) 2003, G. KLYNE.  All rights reserved.
---  See end of this file for licence information.
---------------------------------------------------------------------------------
--- |
---  Module      :  URITest
---  Copyright   :  (c) 2003, Graham Klyne
---  License     :  GPL V2
---
---  Maintainer  :  Graham Klyne
---  Stability   :  provisional
---  Portability :  H98 + multi-parameter classes
---
--- This Module contains test cases for module URI.
---
---------------------------------------------------------------------------------
-
--- WNH RIP OUT module Swish.HaskellUtils.URITest where
-
-import Test.HUnit
-import Swish.HaskellUtils.Parse
-import Swish.HaskellUtils.ProcessURI
-import System.IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )
-
--- Test supplied string for valid URI reference syntax
---   isValidURIRef :: String -> Bool
--- Test supplied string for valid absolute URI reference syntax
---   isAbsoluteURIRef :: String -> Bool
--- Test supplied string for valid absolute URI syntax
---   isAbsoluteURI :: String -> Bool
-
-data URIType = AbsId    -- URI form (absolute, no fragment)
-             | AbsRf    -- Absolute URI reference
-             | RelRf    -- Relative URI reference
-             | InvRf    -- Invalid URI reference
-isValidT :: URIType -> Bool
-isValidT InvRf = False
-isValidT _     = True
-
-isAbsRfT :: URIType -> Bool
-isAbsRfT AbsId = True
-isAbsRfT AbsRf = True
-isAbsRfT _     = False
-
-isAbsIdT :: URIType -> Bool
-isAbsIdT AbsId = True
-isAbsIdT _     = False
-
-testURIRef :: URIType -> String -> Test
-testURIRef t u = TestList
-  [
-    TestCase ( assertEqual ("testValidURIRef:"++u)    (isValidT t) (isValidURIRef    u) ),
-    TestCase ( assertEqual ("testAbsoluteURIRef:"++u) (isAbsRfT t) (isAbsoluteURIRef u) ),
-    TestCase ( assertEqual ("testAbsoluteURI:"++u)    (isAbsIdT t) (isAbsoluteURI    u) )
-  ]
-
-testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc"
-testURIRef002 = testURIRef AbsId "mailto:local@domain.org"
-testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag"
-testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc"
-testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc"
-testURIRef007 = testURIRef RelRf "bbb#ccc"
-testURIRef008 = testURIRef RelRf "#ccc"
-testURIRef009 = testURIRef RelRf "#"
-testURIRef010 = testURIRef RelRf "/"
--- escapes
-testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc"
-testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc"
-testURIRef013 = testURIRef RelRf "%2F"
-testURIRef014 = testURIRef RelRf "aaa%2Fbbb"
--- ports
-testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc"
-testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc"
-testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc"
-testURIRef018 = testURIRef InvRf "http://example.123./aaa/bbb#ccc"
--- IPv6 literals (from RFC2732):
-testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html"
-testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html"
-testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]"
-testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo"
-testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng"
-testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html"
-testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]"
-testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]"
-testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"
--- RFC2396 test cases
-testURIRef031 = testURIRef RelRf "./aaa"
-testURIRef032 = testURIRef RelRf "../aaa"
-testURIRef033 = testURIRef AbsId "g:h"
-testURIRef034 = testURIRef RelRf "g"
-testURIRef035 = testURIRef RelRf "./g"
-testURIRef036 = testURIRef RelRf "g/"
-testURIRef037 = testURIRef RelRf "/g"
-testURIRef038 = testURIRef RelRf "//g"
-testURIRef039 = testURIRef RelRf "?y"
-testURIRef040 = testURIRef RelRf "g?y"
-testURIRef041 = testURIRef RelRf "#s"
-testURIRef042 = testURIRef RelRf "g#s"
-testURIRef043 = testURIRef RelRf "g?y#s"
-testURIRef044 = testURIRef RelRf ";x"
-testURIRef045 = testURIRef RelRf "g;x"
-testURIRef046 = testURIRef RelRf "g;x?y#s"
-testURIRef047 = testURIRef RelRf "."
-testURIRef048 = testURIRef RelRf "./"
-testURIRef049 = testURIRef RelRf ".."
-testURIRef050 = testURIRef RelRf "../"
-testURIRef051 = testURIRef RelRf "../g"
-testURIRef052 = testURIRef RelRf "../.."
-testURIRef053 = testURIRef RelRf "../../"
-testURIRef054 = testURIRef RelRf "../../g"
-testURIRef055 = testURIRef RelRf "../../../g"
-testURIRef056 = testURIRef RelRf "../../../../g"
-testURIRef057 = testURIRef RelRf "/./g"
-testURIRef058 = testURIRef RelRf "/../g"
-testURIRef059 = testURIRef RelRf "g."
-testURIRef060 = testURIRef RelRf ".g"
-testURIRef061 = testURIRef RelRf "g.."
-testURIRef062 = testURIRef RelRf "..g"
-testURIRef063 = testURIRef RelRf "./../g"
-testURIRef064 = testURIRef RelRf "./g/."
-testURIRef065 = testURIRef RelRf "g/./h"
-testURIRef066 = testURIRef RelRf "g/../h"
-testURIRef067 = testURIRef RelRf "g;x=1/./y"
-testURIRef068 = testURIRef RelRf "g;x=1/../y"
-testURIRef069 = testURIRef RelRf "g?y/./x"
-testURIRef070 = testURIRef RelRf "g?y/../x"
-testURIRef071 = testURIRef RelRf "g#s/./x"
-testURIRef072 = testURIRef RelRf "g#s/../x"
--- Invalid
-testURIRef081 = testURIRef RelRf ""
-testURIRef082 = testURIRef InvRf " "
-testURIRef083 = testURIRef InvRf "%"
-testURIRef084 = testURIRef InvRf "A%Z"
-testURIRef085 = testURIRef InvRf "%ZZ"
-testURIRef086 = testURIRef InvRf "%AZ"
-testURIRef087 = testURIRef InvRf "A C"
-testURIRef088 = testURIRef InvRf "A\"C"
-testURIRef089 = testURIRef RelRf "A'C"
-testURIRef090 = testURIRef InvRf "A\"C"
-testURIRef091 = testURIRef InvRf "A`C"
-testURIRef092 = testURIRef InvRf "A<C"
-testURIRef093 = testURIRef InvRf "A>C"
-testURIRef094 = testURIRef InvRf "A^C"
-testURIRef095 = testURIRef InvRf "A\\C"
-testURIRef096 = testURIRef InvRf "A{C"
-testURIRef097 = testURIRef InvRf "A|C"
-testURIRef098 = testURIRef InvRf "A}C"
--- From RFC2396:
--- rel_segment   = 1*( unreserved | escaped |
---                     ";" | "@" | "&" | "=" | "+" | "$" | "," )
--- unreserved    = alphanum | mark
--- mark          = "-" | "_" | "." | "!" | "~" | "*" | "'" |
---                 "(" | ")"
--- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals,
--- or does it?
-testURIRef101 = testURIRef InvRf "A[C"
-testURIRef102 = testURIRef InvRf "A]C"
-testURIRef103 = testURIRef InvRf "A[**]C"
-testURIRef104 = testURIRef InvRf "http://[xyz]/"
-testURIRef105 = testURIRef InvRf "http://]/"
-testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]"
-testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]"
-testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]"
--- Random other things that crop up
-testURIRef111 = testURIRef AbsRf "http://example/Andr&#567;"
-
-testURIRefSuite = TestLabel "Test URIrefs" testURIRefList
-testURIRefList = TestList
-  [
-    testURIRef001, testURIRef002, testURIRef003, testURIRef004,
-    testURIRef005, testURIRef006, testURIRef007, testURIRef008,
-    testURIRef009, testURIRef010,
-    --
-    testURIRef011, testURIRef012, testURIRef013, testURIRef014,
-    testURIRef015, testURIRef016, testURIRef017, testURIRef018,
-    --
-    testURIRef021, testURIRef022, testURIRef023, testURIRef024,
-    testURIRef025, testURIRef026, testURIRef027, testURIRef028,
-    testURIRef029,
-    --
-    testURIRef031, testURIRef032, testURIRef033, testURIRef034,
-    testURIRef035, testURIRef036, testURIRef037, testURIRef038,
-    testURIRef039,
-    testURIRef040, testURIRef041, testURIRef042, testURIRef043,
-    testURIRef044, testURIRef045, testURIRef046, testURIRef047,
-    testURIRef048, testURIRef049,
-    testURIRef050, testURIRef051, testURIRef052, testURIRef053,
-    testURIRef054, testURIRef055, testURIRef056, testURIRef057,
-    testURIRef058, testURIRef059,
-    testURIRef060, testURIRef061, testURIRef062, testURIRef063,
-    testURIRef064, testURIRef065, testURIRef066, testURIRef067,
-    testURIRef068, testURIRef069,
-    testURIRef070, testURIRef071, testURIRef072,
-    --
-    testURIRef081, testURIRef082, testURIRef083, testURIRef084,
-    testURIRef085, testURIRef086, testURIRef087, testURIRef088,
-    testURIRef089,
-    testURIRef090, testURIRef091, testURIRef092, testURIRef093,
-    testURIRef094, testURIRef095, testURIRef096, testURIRef097,
-    testURIRef098, -- testURIRef099,
-    --
-    testURIRef101, testURIRef102, testURIRef103, testURIRef104,
-    testURIRef105, testURIRef106, testURIRef107, testURIRef108,
-    --
-    testURIRef111
-  ]
-
--- Parser tests:  these are fairtly cursory, as the validating tests above
--- are assumed to be conducted using the parser logic.
-
-testParser :: ( Show a, Show b, Eq a, Eq b ) =>
-              String -> Parser a b -> [a] -> [(b,[a])] -> Test
-testParser label parser input result =
-    TestCase ( assertEqual label result ( parser input ) )
-
-noResult :: [ ( String,[Char] ) ]
-noResult = []
-
--- URI parser (see Parse module)
---   parseURIRef :: Parser Char String
-
-testParseRef01 = testParser "testParseRef01" parseURIRef "http://example.org/aaa/bbb#ccc"
-                    [("http://example.org/aaa/bbb#ccc","")]
-testParseRef02 = testParser "testParseRef02" parseURIRef "mailto:local@domain.org ****"
-                    [("mailto:local@domain.org"," ****")]
-testParseRef03 = testParser "testParseRef03" parseURIRef "mailto:local@domain.org#frag|****"
-                    [("mailto:local@domain.org#frag","|****")]
-testParseRef04 = testParser "testParseRef04" parseURIRef "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-                    [("HTTP://EXAMPLE.ORG/AAA/BBB#CCC","")]
-testParseRef05 = testParser "testParseRef05" parseURIRef "//example.org/aaa/bbb#ccc"
-                    [("//example.org/aaa/bbb#ccc","")]
-testParseRef06 = testParser "testParseRef06" parseURIRef "/aaa/bbb#ccc"
-                    [("/aaa/bbb#ccc","")]
-testParseRef07 = testParser "testParseRef07" parseURIRef "bbb#c%aac"    [("bbb#c%aac","")]
-testParseRef08 = testParser "testParseRef08" parseURIRef "#ccc"       [("#ccc","")]
-testParseRef09 = testParser "testParseRef09" parseURIRef "#"          [("#","")]
-testParseRef10 = testParser "testParseRef10" parseURIRef "/"          [("/","")]
-testParseRef11 = testParser "testParseRef11" parseURIRef "A^C"        [("A","^C")]
-testParseRef12 = testParser "testParseRef12" parseURIRef "bbb#ccc%z"  [("bbb#ccc","%z")]
-testParseRef13 = testParser "testParseRef13" parseURIRef "bbb?ccc"    [("bbb?ccc","")]
-testParseRef14 = testParser "testParseRef14" parseURIRef "?ccc"       [("?ccc","")]
-
-testParseRefSuite = TestLabel "Test parseURIRef" testParseRefList
-testParseRefList  = TestList
-  [
-    testParseRef01, testParseRef02, testParseRef03, testParseRef04,
-    testParseRef05, testParseRef06, testParseRef07, testParseRef08,
-    testParseRef09,
-    testParseRef10, testParseRef11, testParseRef12, testParseRef13,
-    testParseRef14
-  ]
-
--- Absolute URI reference parser (see Parse module)
---   parseAbsoluteURIRef :: Parser Char String
-
-testParseAbs01 = testParser "testParseAbs01" parseAbsoluteURIRef
-                    "http://example.org/aaa/bbb#ccc"
-                    [("http://example.org/aaa/bbb#ccc","")]
-testParseAbs02 = testParser "testParseAbs02" parseAbsoluteURIRef
-                    "mailto:local@domain.org ****"
-                    [("mailto:local@domain.org"," ****")]
-testParseAbs03 = testParser "testParseAbs03" parseAbsoluteURIRef
-                    "mailto:local@domain.org#frag|****"
-                    [("mailto:local@domain.org#frag","|****")]
-testParseAbs04 = testParser "testParseAbs04" parseAbsoluteURIRef
-                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-                    [("HTTP://EXAMPLE.ORG/AAA/BBB#CCC","")]
-testParseAbs05 = testParser "testParseAbs05" parseAbsoluteURIRef
-                    "//example.org/aaa/bbb#ccc"
-                    noResult
-testParseAbs06 = testParser "testParseAbs06" parseAbsoluteURIRef
-                    "/aaa/bbb#ccc"
-                    noResult
-testParseAbs07 = testParser "testParseAbs07" parseAbsoluteURIRef
-                    "bbb#c%aac"
-                    noResult
-testParseAbs08 = testParser "testParseAbs08" parseAbsoluteURIRef
-                    "#ccc"
-                    noResult
-testParseAbs09 = testParser "testParseAbs09" parseAbsoluteURIRef
-                    "#"
-                    noResult
-testParseAbs10 = testParser "testParseAbs10" parseAbsoluteURIRef
-                    "/"
-                    noResult
-testParseAbs11 = testParser "testParseAbs11" parseAbsoluteURIRef
-                    "A'C"
-                    noResult
-testParseAbs12 = testParser "testParseAbs12" parseAbsoluteURIRef
-                    "bbb#ccc%z"
-                    noResult
-
-testParseAbsSuite = TestLabel "Test parseAbsoluteURIRef" testParseAbsList
-testParseAbsList  = TestList
-  [
-    testParseAbs01, testParseAbs02, testParseAbs03, testParseAbs04,
-    testParseAbs05, testParseAbs06, testParseAbs07, testParseAbs08,
-    testParseAbs09,
-    testParseAbs10, testParseAbs11, testParseAbs12
-  ]
-
--- Absolute URI parser (see Parse module)
---  parseAbsoluteURI :: Parser Char String
-
-testParseURI01 = testParser "testParseURI01" parseAbsoluteURI
-                    "http://example.org/aaa/bbb#ccc"
-                    [("http://example.org/aaa/bbb","#ccc")]
-testParseURI02 = testParser "testParseURI02" parseAbsoluteURI
-                    "mailto:local@domain.org ****"
-                    [("mailto:local@domain.org"," ****")]
-testParseURI03 = testParser "testParseURI03" parseAbsoluteURI
-                    "mailto:local@domain.org#frag|****"
-                    [("mailto:local@domain.org","#frag|****")]
-testParseURI04 = testParser "testParseURI04" parseAbsoluteURI
-                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-                    [("HTTP://EXAMPLE.ORG/AAA/BBB","#CCC")]
-testParseURI05 = testParser "testParseURI05" parseAbsoluteURI
-                    "//example.org/aaa/bbb#ccc"
-                    noResult
-testParseURI06 = testParser "testParseURI06" parseAbsoluteURI
-                    "/aaa/bbb#ccc"
-                    noResult
-testParseURI07 = testParser "testParseURI07" parseAbsoluteURI
-                    "bbb#c%aac"
-                    noResult
-testParseURI08 = testParser "testParseURI08" parseAbsoluteURI
-                    "#ccc"
-                    noResult
-testParseURI09 = testParser "testParseURI09" parseAbsoluteURI
-                    "#"
-                    noResult
-testParseURI10 = testParser "testParseURI10" parseAbsoluteURI
-                    "/"
-                    noResult
-testParseURI11 = testParser "testParseURI11" parseAbsoluteURI
-                    "A'C"
-                    noResult
-testParseURI12 = testParser "testParseURI12" parseAbsoluteURI
-                    "bbb#ccc%z"
-                    noResult
-
-testParseURISuite = TestLabel "Test parseAbsoluteURI" testParseURIList
-testParseURIList  = TestList
-  [
-    testParseURI01, testParseURI02, testParseURI03, testParseURI04,
-    testParseURI05, testParseURI06, testParseURI07, testParseURI08,
-    testParseURI09,
-    testParseURI10, testParseURI11, testParseURI12
-  ]
-
--- Compare two URIs
--- Takes account of normalizations that can be applied to all URIs
--- (2003-02-20, currently subject to W3C TAG debate)
---   compareURI :: String -> String -> Bool
-
-testCompare :: String -> Bool -> String -> String  -> Test
-testCompare label eq uri1 uri2 =
-    TestCase ( assertEqual label eq ( compareURI uri1 uri2 ) )
-
-testCompare01 = testCompare "testCompare01" True
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/aaa/bbb#ccc"
-testCompare02 = testCompare "testCompare02" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "HTTP://example.org/aaa/bbb#ccc"
-testCompare03 = testCompare "testCompare03" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://EXAMPLE.ORG/aaa/bbb#ccc"
-testCompare04 = testCompare "testCompare04" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/AAA/bbb#ccc"
-testCompare05 = testCompare "testCompare05" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/a%61a/bbb#ccc"
-testCompare06 = testCompare "testCompare06" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/aaa/b%62b#ccc"
-testCompare07 = testCompare "testCompare07" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/aaa/bbb#c%63c"
-testCompare08 = testCompare "testCompare08" False
-                    "mailto:local@example.org"
-                    "mailto:local@ex%61mple.org"
-testCompare09 = testCompare "testCompare09" False
-                    "http://example.org/aaa/bbb#ccc"
-                    "http://example.org/aaa%2Fbbb#ccc"
-testCompare10 = testCompare "testCompare10" False
-                    "http://example.org/aaa%2fbbb#ccc"
-                    "http://example.org/aaa%2Fbbb#ccc"
-
-testCompareSuite = TestLabel "Test compareURI" testCompareList
-testCompareList  = TestList
-  [
-    testCompare01, testCompare02, testCompare03, testCompare04,
-    testCompare05, testCompare06, testCompare07, testCompare08,
-    testCompare09,
-    testCompare10 -- , testCompare11, testCompare12
-  ]
-
--- Separate URI-with-fragment into URI and fragment ID
---   splitURIFragment :: String -> ( String, Maybe String )
--- Construct URI-with-fragment using URI and supplied fragment id
---   makeURIWithFragment :: String -> Maybe String -> String
-
-testSplitFrag :: String -> String -> ( String, Maybe String ) -> Test
-testSplitFrag label input ( main, frag ) = TestList
-    [
-    TestCase ( assertEqual (label++"(split)") ( main, frag ) ( splitURIFragment input ) ),
-    TestCase ( assertEqual (label++"(make)")  input          ( makeURIWithFragment main frag ) )
-    ]
-
-testSplitFrag01 = testSplitFrag "testSplitFrag01"
-                    "http://example.org/aaa/bbb#ccc"
-                    ( "http://example.org/aaa/bbb", Just "ccc" )
-testSplitFrag02 = testSplitFrag "testSplitFrag02"
-                    "mailto:local@domain.org"
-                    ( "mailto:local@domain.org", Nothing )
-testSplitFrag03 = testSplitFrag "testSplitFrag03"
-                    "mailto:local@domain.org#frag"
-                    ( "mailto:local@domain.org", Just "frag" )
-testSplitFrag04 = testSplitFrag "testSplitFrag04"
-                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
-                    ( "HTTP://EXAMPLE.ORG/AAA/BBB", Just "CCC" )
-testSplitFrag05 = testSplitFrag "testSplitFrag05"
-                    "//example.org/aaa/bbb#ccc"
-                    ( "//example.org/aaa/bbb", Just "ccc" )
-testSplitFrag06 = testSplitFrag "testSplitFrag06"
-                    "/aaa/bbb#ccc"
-                    ( "/aaa/bbb", Just "ccc" )
-testSplitFrag07 = testSplitFrag "testSplitFrag07"
-                    "bbb#ccc"
-                    ( "bbb", Just "ccc" )
-testSplitFrag08 = testSplitFrag "testSplitFrag08"
-                    "#ccc"
-                    ( "", Just "ccc" )
-testSplitFrag09 = testSplitFrag "testSplitFrag09"
-                    "#"
-                    ( "", Just "" )
-testSplitFrag10 = testSplitFrag "testSplitFrag10"
-                    "/"
-                    ( "/", Nothing )
-testSplitFrag11 = testSplitFrag "testSplitFrag11"
-                    "aaa%12ccc"
-                    ( "aaa%12ccc", Nothing )
-testSplitFrag12 = testSplitFrag "testSplitFrag12"
-                    "aaa%23ccc"                     -- %23 = '#'
-                    ( "aaa%23ccc", Nothing )
-testSplitFrag13 = testSplitFrag "testSplitFrag13"
-                    "http://example.org/aaa/bbb#"
-                    ( "http://example.org/aaa/bbb", Just "" )
-testSplitFrag14 = testSplitFrag "testSplitFrag14"
-                    ""
-                    ( "", Nothing )
-testSplitFrag15 = testSplitFrag "testSplitFrag15"
-                    "abc"
-                    ( "abc", Nothing )
-testSplitFrag16 = testSplitFrag "testSplitFrag16"
-                    "abc#de:f"
-                    ( "abc", Just "de:f" )
-testSplitFrag17 = testSplitFrag "testSplitFrag17"
-                    "abc#de?f"
-                    ( "abc", Just "de?f" )
-testSplitFrag18 = testSplitFrag "testSplitFrag18"
-                    "abc#de/f"
-                    ( "abc", Just "de/f" )
-
-testSplitFragSuite = TestLabel "Test splitURIFragment" testSplitFragList
-testSplitFragList  = TestList
-  [
-    testSplitFrag01, testSplitFrag02, testSplitFrag03, testSplitFrag04,
-    testSplitFrag05, testSplitFrag06, testSplitFrag07, testSplitFrag08,
-    testSplitFrag09,
-    testSplitFrag10, testSplitFrag11, testSplitFrag12, testSplitFrag13,
-    testSplitFrag14, testSplitFrag15, testSplitFrag16, testSplitFrag17,
-    testSplitFrag18
-  ]
-
-
--- Above tests most cases of makeURIWithFragment,
--- but a couple of extra tests are needed for when the main URI already
--- has a fragment:
-testOverrideFrag label ( main, frag ) result =
-    TestCase ( assertEqual label result ( makeURIWithFragment main frag ) )
-
-testOverrideFrag01 = testOverrideFrag "testOverrideFrag01"
-                        ( "http://example.org/aaa#bbb", (Just "fff") )
-                        "http://example.org/aaa#fff"
-testOverrideFrag02 = testOverrideFrag "testOverrideFrag02"
-                        ( "http://example.org/aaa#bbb", Nothing )
-                        "http://example.org/aaa"
-testOverrideFrag03 = testOverrideFrag "testOverrideFrag03"
-                        ( "http://example.org/aaa#bbb", Just "" )
-                        "http://example.org/aaa#"
-
-testOverrideFragSuite = TestLabel "Test Override Fragment" testOverrideFragList
-testOverrideFragList  = TestList
-  [
-    testOverrideFrag01, testOverrideFrag02, testOverrideFrag03
-  ]
-
--- test getURIRef function
-testGetURIRef :: String -> String -> URI -> Test
-testGetURIRef label strval urival =
-    TestCase ( assertEqual label urival ( getURIRef strval ) )
-
-
-testGetURIRef01 = testGetURIRef "testGetURIRef01"
-                    "foo:xyz"
-                    (URI "foo:" "xyz" [] "" "")
-testGetURIRef02 = testGetURIRef "testGetURIRef02"
-                    "http://example/x/y/z"
-                    (URI "http:" "//example" ["/","x/","y/","z"] "" "")
-testGetURIRef03 = testGetURIRef "testGetURIRef03"
-                    "../abc"
-                    (URI "" "" ["../","abc"] "" "")
-testGetURIRef04 = testGetURIRef "testGetURIRef04"
-                    "http://example/a/b/../../c"
-                    (URI "http:" "//example" ["/","a/","b/","../","../","c"] "" "")
-testGetURIRef05 = testGetURIRef "testGetURIRef04"
-                    "http://example/a/./b/./../c/"
-                    (URI "http:" "//example" ["/","a/","./","b/","./","../","c/",""] "" "")
-
-
-testGetURIRefSuite = TestLabel "Test getURIReg" testGetURIRefList
-testGetURIRefList  = TestList
-  [
-    testGetURIRef01, testGetURIRef02, testGetURIRef03, testGetURIRef04, testGetURIRef05
-  ]
-
--- test normalizeURI function
-testNormalizeURI :: String -> String -> String -> Test
-testNormalizeURI label strval normval =
-    TestCase ( assertEqual (label++": "++strval) normval ( normalizeURI strval ) )
-
-
-testNormalizeURI01 = testNormalizeURI "testNormalizeURI01"
-                    "../abc"
-                    "../abc"
-testNormalizeURI02 = testNormalizeURI "testNormalizeURI02"
-                    "http://example/x/y/z"
-                    "http://example/x/y/z"
-testNormalizeURI03 = testNormalizeURI "testNormalizeURI03"
-                    "http://example/a/b/../../c"
-                    "http://example/c"
-testNormalizeURI04 = testNormalizeURI "testNormalizeURI04"
-                    "http://example/a/b/c/../../"
-                    "http://example/a/"
-testNormalizeURI05 = testNormalizeURI "testNormalizeURI05"
-                    "http://example/a/b/c/./"
-                    "http://example/a/b/c/"
-testNormalizeURI06 = testNormalizeURI "testNormalizeURI06"
-                    "http://example/a/b/c/.././"
-                    "http://example/a/b/"
-testNormalizeURI07 = testNormalizeURI "testNormalizeURI07"
-                    "http://example/a/b/c/d/../../../../e"
-                    "http://example/e"
-testNormalizeURI08 = testNormalizeURI "testNormalizeURI08"
-                    "http://example/a/b/c/d/../.././../../e"
-                    "http://example/e"
-
-testNormalizeURISuite = TestLabel "Test normalizeURI" testNormalizeURIList
-testNormalizeURIList  = TestList
-  [
-    testNormalizeURI01, testNormalizeURI02, testNormalizeURI03, testNormalizeURI04,
-    testNormalizeURI05, testNormalizeURI06, testNormalizeURI07, testNormalizeURI08
-  ]
-
--- Get reference relative to given base
---   relativeRef :: String -> String -> String
--- Get absolute URI given base and relative reference
---   absoluteURI :: String -> String -> String
---
--- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py
--- (Thanks, Dan Connolly)
---
--- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.
--- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
-
-testRelSplit :: String -> String -> String -> String -> Test
-testRelSplit label base uabs urel =
-    TestCase ( assertEqual label urel ( relativeRefPart base uabs ) )
-
-testRelJoin  :: String -> String -> String -> String -> Test
-testRelJoin label base urel uabs =
-    TestCase ( assertEqual label uabs ( absoluteUriPart base urel ) )
-
-testRelative :: String -> String -> String -> String -> Test
-testRelative label base uabs urel = TestList
-    [
-    (testRelSplit (label++"(rel)") base uabs urel),
-    (testRelJoin  (label++"(abs)") base urel (normalizeURI uabs))
-    ]
-
-testRelative01 = testRelative "testRelative01"
-                    "foo:xyz" "bar:abc" "bar:abc"
-testRelative02 = testRelative "testRelative02"
-                    "http://example/x/y/z" "http://example/x/abc" "../abc"
-testRelative03 = testRelative "testRelative03"
-                    "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc"
-                    -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc"
-testRelative04 = testRelative "testRelative04"
-                    "http://ex/x/y/z" "http://ex/x/r" "../r"
-testRelative05 = testRelative "testRelative05"
-                    "http://ex/x/y/z" "http://ex/r" "/r"
-                    -- "http://ex/x/y/z" "http://ex/r" "../../r"
-testRelative06 = testRelative "testRelative06"
-                    "http://ex/x/y" "http://ex/x/q/r" "q/r"
-testRelative07 = testRelative "testRelative07"
-                    "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s"
-testRelative08 = testRelative "testRelative08"
-                    "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t"
-testRelative09 = testRelative "testRelative09"
-                    "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
-testRelative10 = testRelative "testRelative10"
-                    "http://ex/x/y" "http://ex/x/y" "y"
-                    -- "http://ex/x/y" "http://ex/x/y" ""
-testRelative11 = testRelative "testRelative11"
-                    "http://ex/x/y/" "http://ex/x/y/" "./"
-                    -- "http://ex/x/y/" "http://ex/x/y/" ""
-testRelative12 = testRelative "testRelative12"
-                    "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq"
-                    -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" ""
-testRelative13 = testRelative "testRelative13"
-                    "http://ex/x/y/" "http://ex/x/y/z/" "z/"
-testRelative14 = testRelative "testRelative14"
-                    "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal"
-testRelative15 = testRelative "testRelative15"
-                    "file:/e/x/y/z" "file:/e/x/abc" "../abc"
-testRelative16 = testRelative "testRelative16"
-                    "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc"
-testRelative17 = testRelative "testRelative17"
-                    "file:/ex/x/y/z" "file:/ex/x/r" "../r"
-testRelative18 = testRelative "testRelative18"
-                    "file:/ex/x/y/z" "file:/r" "/r"
-testRelative19 = testRelative "testRelative19"
-                    "file:/ex/x/y" "file:/ex/x/q/r" "q/r"
-testRelative20 = testRelative "testRelative20"
-                    "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s"
-testRelative21 = testRelative "testRelative21"
-                    "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#"
-testRelative22 = testRelative "testRelative22"
-                    "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t"
-testRelative23 = testRelative "testRelative23"
-                    "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
-testRelative24 = testRelative "testRelative24"
-                    "file:/ex/x/y" "file:/ex/x/y" "y"
-                    -- "file:/ex/x/y" "file:/ex/x/y" ""
-testRelative25 = testRelative "testRelative25"
-                    "file:/ex/x/y/" "file:/ex/x/y/" "./"
-                    -- "file:/ex/x/y/" "file:/ex/x/y/" ""
-testRelative26 = testRelative "testRelative26"
-                    "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq"
-                    -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" ""
-testRelative27 = testRelative "testRelative27"
-                    "file:/ex/x/y/" "file:/ex/x/y/z/" "z/"
-testRelative28 = testRelative "testRelative28"
-                    "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
-                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
-                    -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
-                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
-testRelative29 = testRelative "testRelative29"
-                    "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
-                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
-                    -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
-                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
-testRelative30 = testRelative "testRelative30"
-                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"
-testRelative31 = testRelative "testRelative31"
-                    "file:/some/dir/foo" "file:/some/dir/#" "./#"
-testRelative32 = testRelative "testRelative32"
-                    "http://ex/x/y" "http://ex/x/q:r" "./q:r"
-                    -- see RFC2396bis, section 5       ^^
-testRelative33 = testRelative "testRelative33"
-                    "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r"
-                    -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r"
-testRelative34 = testRelative "testRelative34"
-                    "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "y?pp/rr"
-testRelative35 = testRelative "testRelative35"
-                    "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z"
-testRelative36 = testRelative "testRelative36"
-                    "mailto:local"
-                    "mailto:local/qual@domain.org#frag"
-                    "local/qual@domain.org#frag"
--- relativeRefPart "mailto:local/qual@domain.org" "mailto:local/qual@domain.org#frag"
-testRelative37 = testRelative "testRelative37"
-                    "mailto:local/qual@domain.org"
-                    "mailto:local/qual@domain.org#frag"
-                    "local/qual@domain.org#frag"
-testRelative38 = testRelative "testRelative38"
-                    "http://ex/x/y?q" "http://ex/x/y?q" "y?q"
-testRelative39 = testRelative "testRelative39"
-                    "http://ex?p" "http://ex/x/y?q" "/x/y?q"
-
--- add escape tests
-testRelative40 = testRelative "testRelative40"
-                    "http://example/x/y%2Fz" "http://example/x/abc" "abc"
-testRelative41 = testRelative "testRelative41"
-                    "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc"
-testRelative42 = testRelative "testRelative42"
-                    "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc"
-testRelative43 = testRelative "testRelative43"
-                    "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc"
-testRelative44 = testRelative "testRelative44"
-                    "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar"
-testRelative45 = testRelative "testRelative45"
-                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
--- Apparently, TimBL prefers the following way to 41, 42 above
--- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html
--- He also notes that there may be different relative fuctions
--- that satisfy the basic equivalence axiom:
--- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
-testRelative46 = testRelative "testRelative46"
-                    "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc"
-testRelative47 = testRelative "testRelative47"
-                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
-
--- Other oddball tests
-    -- Check segment normalization code:
-testRelative50 = testRelative "testRelative50"
-                    "ftp://example/x/y" "http://example/a/b/../../c"  "http://example/c"
-testRelative51 = testRelative "testRelative51"
-                    "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/"
-testRelative52 = testRelative "testRelative52"
-                    "ftp://example/x/y" "http://example/a/b/c/./"     "http://example/a/b/c/"
-testRelative53 = testRelative "testRelative53"
-                    "ftp://example/x/y" "http://example/a/b/c/.././"  "http://example/a/b/"
-testRelative54 = testRelative "testRelative54"
-                    "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e"
-testRelative55 = testRelative "testRelative55"
-                    "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e"
-    -- Check handling of queries and fragments with non-relative paths
-testRelative60 = testRelative "testRelative60"
-                    "mailto:local1@domain1?query1" "mailto:local2@domain2"
-                    "local2@domain2"
-testRelative61 = testRelative "testRelative61"
-                    "mailto:local1@domain1" "mailto:local2@domain2?query2"
-                    "local2@domain2?query2"
-testRelative62 = testRelative "testRelative62"
-                    "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
-                    "local2@domain2?query2"
-testRelative63 = testRelative "testRelative63"
-                    "mailto:local@domain?query1" "mailto:local@domain?query2"
-                    "local@domain?query2"
-testRelative64 = testRelative "testRelative64"
-                    "mailto:?query1" "mailto:local@domain?query2"
-                    "local@domain?query2"
-testRelative65 = testRelative "testRelative65"
-                    "mailto:local@domain?query1" "mailto:?query2"
-                    "?query2"
-
--- testRelative  base abs rel
--- testRelSplit  base abs rel
--- testRelJoin   base rel abs
-testRelative70 = testRelative "testRelative70"
-                    "http://example.org/base/uri" "http:this"
-                    "this"  -- no round-tripping this case
-testRelative71 = testRelSplit "testRelative71"
-                    "http://example.org/base/uri" "http:this"
-                    "this"
-testRelative72 = testRelJoin "testRelative72"
-                    "http://example.org/base/uri" "http:this"
-                    "http:this"
-testRelative73 = testRelJoin "testRelative73"
-                    "http:base" "http:this"
-                    "http:this"
-testRelative74 = testRelJoin "testRelative74"
-                    "f:/a" ".//g"
-                    "f://g"
-testRelative75 = testRelJoin "testRelative74"
-                    "f://example.org/base/a" "b/c//d/e"
-                    "f://example.org/base/b/c//d/e"
-testRelative76 = testRelJoin "testRelative74"
-                    "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org"
-                    "mid:m2@example.ord/c2@example.org"
-
-
-testRelativeSuite = TestLabel "Test Relative URIs" testRelativeList
-testRelativeList  = TestList
-  [ testRelative01, testRelative02, testRelative03, testRelative04
-  , testRelative05, testRelative06, testRelative07, testRelative08
-  , testRelative09
-  , testRelative10, testRelative11, testRelative12, testRelative13
-  , testRelative14, testRelative15, testRelative16, testRelative17
-  , testRelative18, testRelative19
-  , testRelative21, testRelative21, testRelative22, testRelative23
-  , testRelative24, testRelative25, testRelative26, testRelative27
-  , testRelative28, testRelative29
-  , testRelative30, testRelative31, testRelative32, testRelative33
-  , testRelative34, testRelative35, testRelative36, testRelative37
-    --
-  , testRelative40, testRelative41, testRelative42, testRelative43
-  , testRelative44, testRelative45, testRelative46, testRelative47
-    --
-  , testRelative50, testRelative51, testRelative52, testRelative53
-  , testRelative54, testRelative55
-    --
-  , testRelative60, testRelative61, testRelative62, testRelative63
-  , testRelative64, testRelative65
-    --
-  -- , testRelative70
-  , testRelative71, testRelative72, testRelative73
-  , testRelative74, testRelative75, testRelative76
-  ]
-
--- RFC2396 relative-to-absolute URI tests
-
-rfcbase  = "http://a/b/c/d;p?q"
--- normal cases, RFC2396 C.1
-testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h"
-testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g"
-testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g"
-testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/"
-testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g"
-testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g"
-testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y"
-testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y"
-testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s"
-testRFC10 = testRelJoin "testRFC10" rfcbase "g#s" "http://a/b/c/g#s"
-testRFC11 = testRelJoin "testRFC11" rfcbase "g?y#s" "http://a/b/c/g?y#s"
-testRFC12 = testRelJoin "testRFC12" rfcbase ";x" "http://a/b/c/;x"
-testRFC13 = testRelJoin "testRFC13" rfcbase "g;x" "http://a/b/c/g;x"
-testRFC14 = testRelJoin "testRFC14" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s"
-testRFC15 = testRelJoin "testRFC15" rfcbase "." "http://a/b/c/"
-testRFC16 = testRelJoin "testRFC16" rfcbase "./" "http://a/b/c/"
-testRFC17 = testRelJoin "testRFC17" rfcbase ".." "http://a/b/"
-testRFC18 = testRelJoin "testRFC18" rfcbase "../" "http://a/b/"
-testRFC19 = testRelJoin "testRFC19" rfcbase "../g" "http://a/b/g"
-testRFC20 = testRelJoin "testRFC20" rfcbase "../.." "http://a/"
-testRFC21 = testRelJoin "testRFC21" rfcbase "../../" "http://a/"
-testRFC22 = testRelJoin "testRFC22" rfcbase "../../g" "http://a/g"
-testRFC23 = testRelJoin "testRFC23" rfcbase "#s" "#s"   -- current document
-testRFC24 = testRelJoin "testRFC24" rfcbase "" ""       -- current document
--- abnormal cases, RFC2396 C.2
-testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase
-testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/../g"
-testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/../../g"
-testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g"
---testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/./g"  -- RFC2396 says don't remove '.'
-testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/../g"
-testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g."
-testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g"
-testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.."
-testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g"
-testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g"
-testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/"
-testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h"
-testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h"
-testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y"
-testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y"
-testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x"
-testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x"
-testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x"
-testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x"
-testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x"
-
--- Null path tests
--- See RFC2396bis, section 5.2,
--- "If the base URI's path component is the empty string, then a single
---  slash character is copied to the buffer"
-testRFC60 = testRelative "testRFC60" "http://ex"     "http://ex/x/y?q" "/x/y?q"
-testRFC61 = testRelJoin  "testRFC61" "http://ex"     "x/y?q"           "http://ex/x/y?q"
-testRFC62 = testRelative "testRFC62" "http://ex?p"   "http://ex/x/y?q" "/x/y?q"
-testRFC63 = testRelJoin  "testRFC63" "http://ex?p"   "x/y?q"           "http://ex/x/y?q"
-testRFC64 = testRelative "testRFC64" "http://ex#f"   "http://ex/x/y?q" "/x/y?q"
-testRFC65 = testRelJoin  "testRFC65" "http://ex#f"   "x/y?q"           "http://ex/x/y?q"
-testRFC66 = testRelative "testRFC66" "http://ex?p"   "http://ex/x/y#g" "/x/y#g"
-testRFC67 = testRelJoin  "testRFC67" "http://ex?p"   "x/y#g"           "http://ex/x/y#g"
-testRFC68 = testRelative "testRFC68" "http://ex"     "http://ex/"      "/"
-testRFC69 = testRelJoin  "testRFC69" "http://ex"     "./"              "http://ex/"
-testRFC70 = testRelative "testRFC70" "http://ex"     "http://ex/a/b"   "/a/b"
-testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex"       "./"
-
-testRFC2396Suite = TestLabel "Test RFC2396 examples" testRFC2396List
-testRFC2396List  = TestList
-  [
-    testRFC01, testRFC02, testRFC03, testRFC04,
-    testRFC05, testRFC06, testRFC07, testRFC08,
-    testRFC09,
-    testRFC10, testRFC11, testRFC12, testRFC13,
-    testRFC14, testRFC15, testRFC16, testRFC17,
-    testRFC18, testRFC19,
-    testRFC20, testRFC21, testRFC22, testRFC23,
-    testRFC24,
-    -- testRFC30,
-    testRFC31, testRFC32, testRFC33,
-    testRFC34, testRFC35, testRFC36, testRFC37,
-    testRFC38, testRFC39,
-    testRFC40, testRFC41, testRFC42, testRFC43,
-    testRFC44, testRFC45, testRFC46, testRFC47,
-    testRFC48, testRFC49,
-    testRFC50,
-    --
-    testRFC60, testRFC61, testRFC62, testRFC63,
-    testRFC64, testRFC65, testRFC66, testRFC67,
-    testRFC68, testRFC69,
-    testRFC70
-  ]
-
--- And some other oddballs:
-mailbase = "mailto:local/option@domain.org?notaquery#frag"
-testMail01 = testRelJoin "testMail01"
-            mailbase "local@domain"
-            "mailto:local@domain"
-testMail02 = testRelJoin "testMail02"
-            mailbase "#newfrag"
-            "mailto:#newfrag"
-            -- "mailto:local/option@domain.org?notaquery#newfrag"
-testMail03 = testRelJoin "testMail03"
-            mailbase "l1/q1@domain"
-            "mailto:l1/q1@domain"
-
-testMail11 = testRelJoin "testMail11"
-             "mailto:local1@domain1?query1" "mailto:local2@domain2"
-             "mailto:local2@domain2"
-testMail12 = testRelJoin "testMail12"
-             "mailto:local1@domain1" "mailto:local2@domain2?query2"
-             "mailto:local2@domain2?query2"
-testMail13 = testRelJoin "testMail13"
-             "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
-             "mailto:local2@domain2?query2"
-testMail14 = testRelJoin "testMail14"
-             "mailto:local@domain?query1" "mailto:local@domain?query2"
-             "mailto:local@domain?query2"
-testMail15 = testRelJoin "testMail15"
-             "mailto:?query1" "mailto:local@domain?query2"
-             "mailto:local@domain?query2"
-testMail16 = testRelJoin "testMail16"
-             "mailto:local@domain?query1" "?query2"
-             "mailto:?query2"
-testInfo17 = testRelJoin "testInfo17"
-             "info:name/1234/../567" "name/9876/../543"
-             "info:name/9876/../543"
-testInfo18 = testRelJoin "testInfo18"
-             "info:/name/1234/../567" "name/9876/../543"
-             "info:/name/name/543"
-
-testOddballSuite = TestLabel "Test oddball examples" testOddballList
-testOddballList  = TestList
-  [ testMail01, testMail02, testMail03
-  , testMail11, testMail12, testMail13, testMail14, testMail15, testMail16
-  , testInfo17
-  ]
-
--- Full test suite
-allTests = TestList
-  [ testURIRefSuite,
-    testParseRefSuite,
-    testParseAbsSuite,
-    testParseURISuite,
-    testCompareSuite,
-    testSplitFragSuite,
-    testOverrideFragSuite,
-    testGetURIRefSuite,
-    testNormalizeURIList,
-    testRelativeSuite,
-    testRFC2396Suite,
-    testOddballSuite
-  ]
-
-main = runTestTT allTests
-
-runTestFile t = do
-    h <- openFile "a.tmp" WriteMode
-    runTestText (putTextToHandle h False) t
-    hClose h
-tf = runTestFile
-tt = runTestTT
-
-uref = testURIRefSuite
-pref = testParseRefSuite
-pabs = testParseAbsSuite
-puri = testParseURISuite
-comp = testCompareSuite
-frag = testSplitFragSuite
-over = testOverrideFragSuite
-guri = testGetURIRefSuite
-nuri = testNormalizeURIList
-tr01 = testRelative01
-tr02 = testRelative02
-tr03 = testRelative03
-tr04 = testRelative04
-rel  = testRelativeSuite
-rfc  = testRFC2396Suite
-oddb = testOddballSuite
-
---------------------------------------------------------------------------------
---
---  Copyright (c) 2003, G. KLYNE.  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
---
---------------------------------------------------------------------------------
--- $Source: /file/cvsdev/HaskellUtils/URITest.hs,v $
--- $Author: graham $
--- $Revision: 1.2 $
--- $Log: URITest.hs,v $
--- Revision 1.2  2004/01/22 19:52:27  graham
--- Rename module URI to avoid awkward clash with Haskell libraries
---
--- Revision 1.1  2004/01/13 12:31:24  graham
--- Move modules from HaskellRDF to HaskellUtils project
---
--- Revision 1.21  2004/01/06 13:53:10  graham
--- Created consolidated test harness (SwishTestAll.hs)
---
--- Revision 1.20  2003/11/07 21:45:47  graham
--- Started rework of datatype to use new DatatypeRel structure.
---
--- Revision 1.19  2003/09/24 18:50:52  graham
--- Revised module format to be Haddock compatible.
---
--- Revision 1.18  2003/09/24 13:35:43  graham
--- QName splitting moved from URI module to QName module
---
--- Revision 1.17  2003/06/24 19:55:50  graham
--- Another test case added
---
--- Revision 1.16  2003/06/18 23:37:09  graham
--- Another test case.
---
--- Revision 1.15  2003/06/17 15:42:36  graham
--- Misc updates
---
--- Revision 1.14  2003/06/10 01:04:46  graham
--- Proof framework in progress;  compiles, incomplete
---
--- Revision 1.13  2003/06/03 19:24:14  graham
--- Updated all source modules to cite GNU Public Licence
---
--- Revision 1.12  2003/05/29 13:04:42  graham
--- All tests now compile and pass as stand-alone programs compiled
--- using GHC.  Added batch files to compile programs and run tests.
---
--- Revision 1.11  2003/04/17 00:35:39  graham
--- Added module N3ParserTest
--- N3parser is mostly working
--- Formulae remain to test
---
--- Revision 1.10  2003/03/05 22:16:24  graham
--- URI code passes all unit tests
---
--- Revision 1.9  2003/03/05 14:47:45  graham
--- Relative URI code complete, not tested
--- Fixed a URI parser bug
---
--- Revision 1.8  2003/02/28 14:02:52  graham
--- A few new test cases
---
--- Revision 1.7  2003/02/27 23:33:54  graham
--- QName splitting tested OK
---
--- Revision 1.6  2003/02/27 20:29:53  graham
--- Fixed some more parser bugs.
--- All parser tests pass.
--- QName and relative path handling to do.
---
--- Revision 1.5  2003/02/27 18:48:05  graham
--- Fix URI parser bug.
--- Add more URI parser test cases.
---
--- Revision 1.4  2003/02/27 15:28:45  graham
--- Updated internal structure of parsed URI.
--- Passes parser unit tests
---
--- Revision 1.3  2003/02/27 09:50:25  graham
--- Add URI parser test cases, some name changes
---
--- Revision 1.2  2003/02/27 00:30:14  graham
--- Syntax code nearly complete, untested
---
--- Revision 1.1  2003/02/20 19:45:07  graham
--- Add URI module and unit tests.
--- Code incomplete.
---
+ Swish/RDF/BuiltInDatatypes.hs view
@@ -0,0 +1,84 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  BuiltInDatatypes+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module collects references and provides access to all of the+--  datatypes built in to Swish.+--+--------------------------------------------------------------------------------++module Swish.RDF.BuiltInDatatypes+    ( allDatatypes, findRDFDatatype )+where++import Swish.RDF.RDFDatatype+    ( RDFDatatype+    )++import Swish.Utils.LookupMap+    ( LookupMap(..), mapFindMaybe+    )++import Swish.Utils.Namespace+    ( ScopedName(..) )++import Swish.RDF.RDFDatatypeXsdString+    ( rdfDatatypeXsdString )++import Swish.RDF.RDFDatatypeXsdInteger+    ( rdfDatatypeXsdInteger )++------------------------------------------------------------+--  Declare datatype map+------------------------------------------------------------++allDatatypes :: [RDFDatatype]+allDatatypes =+    [ rdfDatatypeXsdString+    , rdfDatatypeXsdInteger+    ]++findRDFDatatype :: ScopedName -> Maybe RDFDatatype+findRDFDatatype nam = mapFindMaybe nam (LookupMap allDatatypes)++------------------------------------------------------------+--  Declare datatype subtypes map+------------------------------------------------------------++{-+allDatatypeSubtypes :: [xxx]+allDatatypeSubtypes = []+--  [[[details TBD]]]+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/BuiltInMap.hs view
@@ -0,0 +1,52 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  BuiltInMap+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module collects references and provides access to all of the+--  datatypes, variable binding modifiers and variable binding filters+--  built in to Swish.+--+--------------------------------------------------------------------------------++module Swish.RDF.BuiltInMap+    ( findRDFOpenVarBindingModifier+    , findRDFDatatype+    , rdfRulesetMap+    , allRulesets, allDatatypeRulesets+    )+where++import Swish.RDF.BuiltInDatatypes+import Swish.RDF.BuiltInRules++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/BuiltInRules.hs view
@@ -0,0 +1,162 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  BuiltInRules+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module collects references and provides access to all of the+--  rulesets, variable binding modifiers and variable binding filters+--  built in to Swish.+--+--------------------------------------------------------------------------------++module Swish.RDF.BuiltInRules+    ( findRDFOpenVarBindingModifier+    , rdfRulesetMap+    , allRulesets, allDatatypeRulesets+    )+where++import Swish.RDF.BuiltInDatatypes+    ( allDatatypes )++import Swish.RDF.RDFVarBinding+    ( RDFOpenVarBindingModify+    , rdfVarBindingUriRef, rdfVarBindingBlank+    , rdfVarBindingLiteral+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped+    , rdfVarBindingMemberProp+    )++import Swish.RDF.RDFRuleset+    ( RDFRuleset, RDFRulesetMap )++import Swish.RDF.RDFProofContext+    ( rulesetRDF+    , rulesetRDFS+    , rulesetRDFD )++import Swish.RDF.VarBinding+    ( nullVarBindingModify+    , makeVarFilterModify+    , varFilterEQ, varFilterNE+    )++import Swish.RDF.Datatype+    ( typeRules+    , typeMkModifiers+    )++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , mapFindMaybe+    )++import Swish.Utils.Namespace+    ( ScopedName(..) )++------------------------------------------------------------+--  Declare variable binding filters list+------------------------------------------------------------++-- |List of rdfOpenVarBindingModify values for predefined filters+--+rdfVarBindingFilters :: [RDFOpenVarBindingModify]+rdfVarBindingFilters =+    [ filter1 rdfVarBindingUriRef+    , filter1 rdfVarBindingBlank+    , filter1 rdfVarBindingLiteral+    , filter1 rdfVarBindingUntypedLiteral+    , filter1 rdfVarBindingTypedLiteral+    , filter1 rdfVarBindingXMLLiteral+    , filter1 rdfVarBindingMemberProp+    , filter2 rdfVarBindingDatatyped+    -- , filterN nullVarBindingModify+    , filter2 varFilterEQ+    , filter2 varFilterNE+    ]+    where+        filter1 f lbs = makeVarFilterModify $ f (head lbs)+        filter2 f lbs = makeVarFilterModify $ f (head lbs) (lbs!!1)+        -- filterN f lbs = makeVarFilterModify $ f ...++------------------------------------------------------------+--  Declare variable binding modifiers map+------------------------------------------------------------++rdfVarBindingModifiers :: [RDFOpenVarBindingModify]+rdfVarBindingModifiers =+    [ nullVarBindingModify+    ]++------------------------------------------------------------+--  Find a named built-in OpenVarBindingModifier+------------------------------------------------------------++allOpenVarBindingModify :: [RDFOpenVarBindingModify]+allOpenVarBindingModify =+    rdfVarBindingFilters    +++    rdfVarBindingModifiers  +++    dtsVarBindingModifiers++dtsVarBindingModifiers :: [RDFOpenVarBindingModify]+-- dtsVarBindingModifiers = concatMap dtVarBindingModifiers allDatatypes+dtsVarBindingModifiers = concatMap typeMkModifiers allDatatypes++{-+dtVarBindingModifiers dtval =+    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)+-}++findRDFOpenVarBindingModifier :: ScopedName -> Maybe RDFOpenVarBindingModify+findRDFOpenVarBindingModifier nam =+    mapFindMaybe nam (LookupMap allOpenVarBindingModify)++------------------------------------------------------------+--  Lookup map for built-in rulesets+------------------------------------------------------------++rdfRulesetMap :: RDFRulesetMap+rdfRulesetMap = LookupMap allRulesets++allRulesets :: [RDFRuleset]+allRulesets =+    [ rulesetRDF+    , rulesetRDFS+    , rulesetRDFD+    ]+    ++ allDatatypeRulesets++allDatatypeRulesets :: [RDFRuleset]+allDatatypeRulesets = map typeRules allDatatypes++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/ClassRestrictionRule.hs view
@@ -0,0 +1,603 @@+{-# LANGUAGE MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  ClassRestrictionRule+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  MultiParamTypeClasses+--+--  This module implements an inference rule based on a restruction on class+--  membership of one or more values.+--+--------------------------------------------------------------------------------++module Swish.RDF.ClassRestrictionRule+    ( ClassRestriction(..), ClassRestrictionFn+    , makeDatatypeRestriction, makeDatatypeRestrictionFn+    , makeRDFClassRestrictionRules+    , makeRDFDatatypeRestrictionRules+    , falseGraph, falseGraphStr+    )+where++import Swish.RDF.RDFGraph+    ( RDFLabel(..)+    , getScopedName+    , RDFGraph+    , getArcs+    , merge+    , toRDFGraph, emptyRDFGraph+    , Arc(..)+    , res_rdf_type+    , res_rdfd_maxCardinality+    )++import Swish.RDF.RDFRuleset+    ( RDFRule+    , makeRDFGraphFromN3String+    )++import Swish.RDF.RDFDatatype+    ( RDFDatatypeVal+    , fromRDFLabel, toRDFLabel+    )++import Swish.RDF.RDFQuery+    ( rdfQueryFind+    , rdfFindValSubj, rdfFindPredVal, rdfFindPredInt+    , rdfFindList+    )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding )++import Swish.RDF.Datatype+    ( DatatypeVal(..)+    , DatatypeRel(..), DatatypeRelFn+    )++import Swish.RDF.Rule+    ( Rule(..)+    , bwdCheckInference+    )++import Swish.RDF.VarBinding+    ( VarBinding(..)+    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( namespaceRDFD+    )++import Swish.Utils.PartOrderedCollection+    ( minima, maxima+    , partCompareEq, partComparePair+    , partCompareListMaybe+    , partCompareListSubset+    )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , mapFindMaybe+    )++import Swish.Utils.ListHelpers+    ( powerSet )++import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)++import Data.List+    ( delete, nub, (\\) )++import Control.Monad+    ( liftM )++import Swish.Utils.TraceHelpers+    ( trace )++------------------------------------------------------------+--  Class restriction data type+------------------------------------------------------------++-- |Type of function that evaluates missing node values in a+--  restriction from those supplied.+type ClassRestrictionFn = [Maybe RDFLabel] -> Maybe [[RDFLabel]]++-- |Datatype for named class restriction+data ClassRestriction = ClassRestriction+    { crName    :: ScopedName+    , crFunc    :: ClassRestrictionFn+    }++instance Eq ClassRestriction where+    cr1 == cr2  =  crName cr1 == crName cr2++instance Show ClassRestriction where+    show cr = "ClassRestriction:" ++ show (crName cr)++instance LookupEntryClass ClassRestriction ScopedName ClassRestriction+    where+    newEntry (_,fn) = fn+    keyVal cr = (crName cr, cr)++------------------------------------------------------------+--  Instantiate a class restriction from a datatype relation+------------------------------------------------------------++-- |Make a class restriction from a datatype relation.+--+--  This lifts application of the datatype relation to operate+--  on 'RDFLabel' values, which are presumed to contain appropriately+--  datatyped values.+--+makeDatatypeRestriction ::+    RDFDatatypeVal vt -> DatatypeRel vt -> ClassRestriction+makeDatatypeRestriction dtv dtrel = ClassRestriction+    { crName = dtRelName dtrel+    , crFunc = makeDatatypeRestrictionFn dtv (dtRelFunc dtrel)+    }++--  The core logic below is something like @(map toLabels . dtrelfn . map frLabel)@+--  but the extra lifting and catMaybes are needed to get the final result+--  type in the right form.++-- |Make a class restriction function from a datatype relation function.+--+makeDatatypeRestrictionFn ::+    RDFDatatypeVal vt -> DatatypeRelFn vt -> ClassRestrictionFn+makeDatatypeRestrictionFn dtv dtrelfn =+    liftM (mapMaybe toLabels) . dtrelfn . map frLabel+    where+        frLabel Nothing  = Nothing+        frLabel (Just l) = fromRDFLabel dtv l+        toLabels         = mapM toLabel   -- Maybe [RDFLabel]+        toLabel          = toRDFLabel dtv++------------------------------------------------------------+--  Make rules from supplied class restrictions and graph+------------------------------------------------------------++ruleQuery :: RDFGraph+ruleQuery = makeRDFGraphFromN3String $+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" +++    " ?c a rdfd:GeneralRestriction ; " +++    "    rdfd:onProperties ?p ; "      +++    "    rdfd:constraint   ?r . "++--  Placeholder false graph for now.+falseGraph :: RDFGraph+falseGraph = makeRDFGraphFromN3String $+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" +++    falseGraphStr++falseGraphStr :: String+falseGraphStr = "_:a rdfd:false _:b . "++-- |Make a list of class restriction rules given a list of class restriction+--  values and a graph containing one or more class restriction definitions.+--+makeRDFClassRestrictionRules :: [ClassRestriction] -> RDFGraph -> [RDFRule]+makeRDFClassRestrictionRules crs gr =+    mapMaybe constructRule (queryForRules gr)+    where+        queryForRules = rdfQueryFind ruleQuery+        constructRule = makeRestrictionRule1 crs gr++makeRestrictionRule1 ::+    [ClassRestriction] -> RDFGraph -> RDFVarBinding -> Maybe RDFRule+makeRestrictionRule1 crs gr vb =+    {-+    trace "\nmakeRestrictionRule1:" $+    -- seq (traceShow "\ngr:" gr)+    seq (traceShow "\nvb:" vb) $+    seq (traceShow "\nc:" c) $+    seq (traceShow "\np:" p) $+    seq (traceShow "\nr:" r) $+    seq (traceShow "\nps:" ps) $+    -- seq (traceShow "\nrn:" rn) $+    -}+    makeRestrictionRule2 rn c ps cs+    where+        c  = fromMaybe NoNode $ vbMap vb (Var "c")+        p  = fromMaybe NoNode $ vbMap vb (Var "p")+        r  = fromMaybe NoNode $ vbMap vb (Var "r")+        cs = filter (>0) $ map fromInteger $+             rdfFindPredInt c res_rdfd_maxCardinality gr+        ps = rdfFindList gr p+        rn = mapFindMaybe (getScopedName r) (LookupMap crs)++makeRestrictionRule2 ::+    Maybe ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int]+    -> Maybe RDFRule+makeRestrictionRule2 (Just restriction) cls@(Res cname) props cs =+    {-+    trace "\nmakeRestrictionRule2:" $+    seq (traceShow "\ncls:" cls)+    seq (traceShow "\nprops:" props) $+    -}+    Just restrictionRule+    where+        restrictionRule = Rule+            { ruleName = cname+              -- fwdApply :: [ex] -> [ex]+            , fwdApply = fwdApplyRestriction restriction cls props cs+              -- bwdApply :: ex -> [[ex]]+            , bwdApply = bwdApplyRestriction restriction cls props cs+            , checkInference = bwdCheckInference restrictionRule+            }+makeRestrictionRule2 _ _ _ _ =+    trace "\nmakeRestrictionRule: missing class restriction"+    Nothing++--  Forward apply class restriction.+fwdApplyRestriction ::+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> [RDFGraph]+    -> [RDFGraph]+fwdApplyRestriction restriction cls props cs antgrs =+    if isJust newgrs then concat $ fromJust newgrs else [falseGraph]+    where+        -- Instances of the named class in the graph:+        ris = nub $ rdfFindValSubj res_rdf_type cls antgr+        --  Merge antecedent graphs into one (with bnode renaming):+        --  (Uses 'if' and 'foldl1' to avoid merging in the common case+        --  of just one graph supplied.)+        antgr = if null antgrs then emptyRDFGraph else foldl1 merge antgrs+        --  Apply class restriction to single instance of the restricted class+        newgr :: RDFLabel -> Maybe [RDFGraph]+        newgr ri = fwdApplyRestriction1 restriction ri props cs antgr+        newgrs :: Maybe [[RDFGraph]]+        newgrs = mapM newgr ris++--  Forward apply class restriction to single class instance (ci).+--  Return single set of inferred results, for each combination of+--  property values, or an empty list, or Nothing if the supplied values+--  are inconsistent with the restriction.+fwdApplyRestriction1 ::+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph+    -> Maybe [RDFGraph]+fwdApplyRestriction1 restriction ci props cs antgr =+    {-+    trace "\nfwdApplyRestriction1:" $+    seq (traceShow "\nci:" ci)+    seq (traceShow "\nprops:" props)+    seq (traceShow "\nantgr:" antgr) $+    -}+    if grConsistent then Just newgrs else Nothing+    where+        --  Apply restriction to graph+        (grConsistent,_,_,sts) = applyRestriction restriction ci props cs antgr+        --  Select results, eliminate those with unknowns+        nts :: [[RDFLabel]]+        nts = mapMaybe sequence sts+        --  Make new graph from results, including only newly generated arcs+        newarcs = nub [Arc ci p v | vs <- nts, (p,v) <- zip props vs ]+                  \\ getArcs antgr+        newgrs  = if null newarcs then [] else [toRDFGraph newarcs]++--  Backward apply class restriction.+--+--  Returns a list of alternatives, any one of which is sufficient to+--  satisfy the given consequent.+--+bwdApplyRestriction ::+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph+    -> [[RDFGraph]]+bwdApplyRestriction restriction cls props cs congr =+    fromMaybe [[falseGraph]] newgrs+    where+        -- Instances of the named class in the graph:+        ris = rdfFindValSubj res_rdf_type cls congr+        --  Apply class restriction to single instance of the restricted class+        newgr :: RDFLabel -> Maybe [[RDFGraph]]+        newgr ri = bwdApplyRestriction1 restriction cls ri props cs congr+        --  'map newgr ris' is conjunction of disjunctions, where+        --  each disjunction is itself a conjunction of conjunctions.+        --  'sequence' distributes the conjunction over the disjunction,+        --  yielding an equivalent disjunction of conjunctions+        --  map concat flattens the conjunctions of conjuctions+        newgrs :: Maybe [[RDFGraph]]+        newgrs = liftM (map concat . sequence) $ mapM newgr ris++--  Backward apply a class restriction to single class instance (ci).+--  Return one or more sets of antecedent results from which the consequence+--  can be derived in the defined relation, an empty list if the supplied+--  consequence cannot be inferred, or Nothing if the consequence is+--  inconsistent with the restriction.+bwdApplyRestriction1 ::+    ClassRestriction -> RDFLabel -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph+    -> Maybe [[RDFGraph]]+bwdApplyRestriction1 restriction cls ci props cs congr =+    if grConsistent then Just grss else Nothing+    {-+    trace "\nfwdApplyRestriction1:" $+    seq (traceShow "\nci:" ci)+    seq (traceShow "\nprops:" props)+    seq (traceShow "\ncongr:" congr) $+    -}+    where+        --  Apply restriction to graph+        (grConsistent,pvs,cts,_) =+            applyRestriction restriction ci props cs congr+        --  Build list of all full tuples consistent with the values supplied+        fts :: [[RDFLabel]]+        fts = concatMap snd cts+        --  Construct partial tuples from members of fts from which at least+        --  one of the supplied values can be derived+        pts :: [([Maybe RDFLabel],[RDFLabel])]+        pts = concatMap (deriveTuple restriction) fts+        --  Select combinations of members of pts from which all the+        --  supplied values can be derived+        dtss :: [[[Maybe RDFLabel]]]+        dtss = coverSets pvs pts+        --  Filter members of dtss that fully cover the values+        --  obtained from the consequence graph.+        ftss :: [[[Maybe RDFLabel]]]+        ftss = filter (not . (\t -> coversVals deleteMaybe t pvs)) dtss+        --  Make new graphs for all alternatives+        grss :: [[RDFGraph]]+        grss = map ( makeGraphs . newArcs ) ftss+        --  Collect arcs for one alternative+        newArcs dts =+            [ Arc ci p v | mvs <- dts, (p,Just v) <- zip props mvs ]+        --  Make graphs for one alternative+        makeGraphs = map (toRDFGraph . (:[])) . (Arc ci res_rdf_type cls :)++--  Helper function to select sub-tuples from which some of a set of+--  values can be derived using a class restriction.+--+--  restriction is the restriction being evaluated.+--  ft          is a full tuple of values known to be consistent with+--              the restriction+--+--  The result returned is a list of pairs, whose first member is a partial+--  tuples from which the full tuple supplied can be derived, and the second+--  is the supplied tuple calculated from that input.+--+deriveTuple ::+    ClassRestriction -> [RDFLabel]+    -> [([Maybe RDFLabel],[RDFLabel])]+deriveTuple restriction ft =+    map (tosnd ft) $ minima partCompareListMaybe $ filter derives partials+    where+        partials = mapM (\x -> [Nothing,Just x]) ft+        derives  = ([ft]==) . fromJust . crFunc restriction+        tosnd    = flip (,)++--  Helper function to apply a restriction to selected information from+--  a supplied graph, and returns a tuple containing:+--  (a) an indication of whether the graph is consistent with the+--      restriction+--  (b) a list of values specified in the graph for each property+--  (c) a complete list of tuples that use combinations of values from+--      the graph and are consistent with the restriction.+--      Each member is a pair consisting of some combination of input+--      values, and a list of complete tuple values that can be+--      calculated from those inputs, or an empty list if there is+--      insufficient information.+--  (d) a set of tuples that are consistent with the restriction and use+--      as much information from the graph as possible.  This set is+--      minimal in the sense that they must all correspond to different+--      complete input tuples satisfying the restriction.+--+--  This function factors out logic that is common to forward and+--  backward chaining of a class restriction.+--+--  restriction is the class restriction being applied+--  ci          is the identifier of a graph node to be tested+--  props       is a list of properties of the graph noode whose values+--              are constrained by the class restriction.+--  cs          is a list of max cardinality constraints on the restriction,+--              the minimum of which is used as the cardinality constraint+--              on the restriction.  If the list is null, no cardinality+--              constraint is applied.+--  gr          is the graph from which property values are extracted.+--+applyRestriction ::+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph+    -> ( Bool+       , [[RDFLabel]]+       , [([Maybe RDFLabel],[[RDFLabel]])]+       , [[Maybe RDFLabel]]+       )+applyRestriction restriction ci props cs gr =+    (coversVals deleteMaybe sts pvs && cardinalityOK, pvs, cts, sts )+    where+        --  Extract from the antecedent graph all specified values of the+        --  restricted properties (constructs inner list for each property)+        pvs :: [[RDFLabel]]+        pvs = [ rdfFindPredVal ci p gr | p <- props ]+        --  Convert tuple of alternatives to list of alternative tuples+        --  (Each tuple is an inner list)+        pts :: [[Maybe RDFLabel]]+        pts = mapM allJustAndNothing pvs+        --  Try class restriction calculation for each tuple+        --  For each, result may be:+        --    Nothing  (inconsistent)+        --    Just []  (underspecified)+        --    Just [t] (single tuple of values derived from given values)+        --    Just ts  (alternative tuples derived from given values)+        rts :: [Maybe [[RDFLabel]]]+        rts = map (crFunc restriction) pts+        +        --  Extract list of consistent tuples of given values+        cts :: [([Maybe RDFLabel],[[RDFLabel]])]+        cts = mapMaybe tupleConv (zip pts rts)+        +        --  TODO: be more idiomatic?+        tupleConv :: (a, Maybe b) -> Maybe (a,b)+        tupleConv (a, Just b)  = Just (a,b)+        tupleConv _            = Nothing+        +        --  Build list of consistent tuples with maximum information+        --  based on that supplied and available+        -- mts = concatMap mostValues cts+        mts = map mostOneValue cts+        --  Eliminate consistent results subsumed by others.+        --  This results in a mimimal possible set of consistent inputs,+        --  because if any pair could be consistently unified then their+        --  common subsumer would still be in the list, and both would be+        --  thereby eliminated.+        sts :: [[Maybe RDFLabel]]+        sts = maxima partCompareListMaybe mts+        --  Check the cardinality constraint+        cardinalityOK = null cs || length sts <= minimum cs+        +--  Map a non-empty list of values to a list of Just values,+--  preceding each with a Nothing element.+--+--  Nothing corresponds to an unknown value.  This logic is used+--  as part of constructing a list of alternative tuples of known+--  data values (either supplied or calculated from the class+--  restriction).+--+allJustAndNothing :: [a] -> [Maybe a]+allJustAndNothing as = Nothing:map Just as++{-+--  Get maximum information about possible tuple values from a+--  given pair of input tuple, which is known to be consistent with+--  the restriction, and calculated result tuples.  Where the result+--  tuple is not exactly calculated, return the input tuple.+--+--  imvs    tuple of Maybe element values, with Nothing for+--          unspecified values+--  movss   Maybe list of possible fully-specified result tuples,+--          an empty list if no result tuples can be computed+--          based on the input tuple, or Nothing if the input+--          tuple is inconsistent.+--+mostValues :: ([Maybe a],[[a]]) -> [[Maybe a]]+mostValues (imvs,([])) = [imvs]+mostValues (_,movss) = map (map Just) movss+-}++--  Get maximum information about possible tuple values from a+--  given pair of input and possible result tuples, which is+--  known to be consistent with the restriction.  If the result+--  tuple is not exactly calculated, return the input tuple.+--+--  This is a variant of mostValues that returns a single vector.+--  Multiple possible values are considered to be equivalent to+--  Just [], i.e. unknown result.+--+--  imvs    tuple of Maybe element values, with Nothing for+--          unspecified values+--  movss   Maybe list of possible fully-specified result tuples,+--          or an empty list if no result tuples can be computed+--          based on the input tuple.+--+mostOneValue :: ([Maybe a],[[a]]) -> [Maybe a]+mostOneValue (_,[movs]) = map Just movs+mostOneValue (imvs,_)   = imvs++--  Helper function that returns subsets of dts that "cover" the indicated+--  values;  i.e. from which all of the supplied values can be deduced+--  by the enumerated function results.  The minima of all such subsets is+--  returned, as each of these corresponds to some minimum information needed+--  to deduce all of the given values.+--+--  pvs     is a list of lists of values to be covered.  The inner list+--          contains multiple values for each member of a tuple.+--  dts     is an enumerated list of function values from some subset of+--          the tuple space to complete tuples.  Each member is a pair+--          containing the partial tuple (using Nothing for unspecified+--          values) and the full tuple calculated from it.+--+--  The return value is a disjunction of conjunctions of partial tuples+--  that cover the indicated parameter values.+--+--  NOTE:+--  The result minimization is not perfect (cf. test2 below), but I believe+--  it is adequate for the practical situations I envisage, and in any+--  case will not result in incorrect values.  It's significance is for+--  search-tree pruning.  A perfect minimization might be achieved by+--  using a more subtle partial ordering that takes account of both subsets+--  and the partial ordering of set members in place of 'partCompareListSubset'.+--+coverSets  :: (Eq a) => [[a]] -> [([Maybe a],[a])] -> [[[Maybe a]]]+coverSets pvs dts =+    minima partCompareListSubset $ map (map fst) ctss+    where+        ctss = filter coverspvs $ powerSet cts+        cts  = minima (partComparePair partCompareListMaybe partCompareEq) dts+        coverspvs cs = coversVals delete (map snd cs) pvs++--  Does a supplied list of tuples cover a list of possible alternative+--  values for each tuple member?+--+coversVals :: (a->[b]->[b]) -> [[a]] -> [[b]] -> Bool+coversVals dropVal ts vss =+    -- all null (foldr dropUsed vss ts)+    any (all null) (scanr dropUsed vss ts)+    where+        --  Remove single tuple values from the list of supplied values:+        dropUsed []       []     = []+        dropUsed (a:as) (bs:bss) = dropVal a bs : dropUsed as bss+        dropUsed _ _ = error "coversVals.dropUsed: list length mismatch"++{-+--  Does a supplied list of possible alternative values for each+--  element of a tuple cover every tuple in a supplied list?+--+--  (See module spike-coverVals.hs for test cases)+--+coversAll :: ([a]->b->Bool) -> [[a]] -> [[b]] -> Bool+coversAll matchElem vss ts = all (invss vss) ts+    where+        --  Test if a given tuple is covered by vss+        invss vss t = and $ zipWith matchElem vss t++--  Test if the value in a Maybe is contained in a list.+maybeElem :: (Eq a) => Maybe a -> [a] -> Bool+maybeElem Nothing  = const True+maybeElem (Just t) = elem t+-}++-- |Delete a Maybe value from a list+deleteMaybe :: (Eq a) => Maybe a -> [a] -> [a]+deleteMaybe Nothing  as = as+deleteMaybe (Just a) as = delete a as++------------------------------------------------------------+--  Make restriction rules from supplied datatype and graph+------------------------------------------------------------++makeRDFDatatypeRestrictionRules :: RDFDatatypeVal vt -> RDFGraph -> [RDFRule]+makeRDFDatatypeRestrictionRules dtval gr =+    makeRDFClassRestrictionRules dcrs gr+    where+        dcrs = map (makeDatatypeRestriction dtval) (tvalRel dtval)++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/Datatype.hs view
@@ -0,0 +1,1053 @@+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Datatype+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  ExistentialQuantification, MultiParamTypeClasses+--+--  This module defines the structures used by Swish to represent and+--  manipulate datatypes.  It is designed as a basis for handling datatyped+--  RDF literals, but the functions in this module are more generic.+--+--------------------------------------------------------------------------------++--  Testing note:  this module supports a number of specific datatypes.+--  It is intended that functionality in this module will be tested via+--  modules "Swish.RDF.RDFDatatype", +--  "Swish.RDF.ClassRestrictionRule" and+--  "Swish.RDF.RDFDatatypeXsdInteger".+--  See also module ClassRestrictionRuleTest for test cases.++module Swish.RDF.Datatype+    ( Datatype(..)+    , typeName, typeRules, typeMkRules, typeMkModifiers, typeMkCanonicalForm+    , getTypeAxiom, getTypeRule+    , DatatypeVal(..)+    , getDTMod+    , getDTRel+    , tvalMkCanonicalForm+    , DatatypeMap(..)+    , DatatypeRel(..), DatatypeRelFn, DatatypeRelPr+    , altArgs+    , UnaryFnDescr,    UnaryFnTable,    UnaryFnApply,    unaryFnApp+    , BinaryFnDescr,   BinaryFnTable,   BinaryFnApply,   binaryFnApp+    , BinMaybeFnDescr, BinMaybeFnTable, BinMaybeFnApply, binMaybeFnApp+    , ListFnDescr,     ListFnTable,     ListFnApply,     listFnApp+    , DatatypeMod(..), ModifierFn+    , ApplyModifier+    , nullDatatypeMod+    -- , applyDatatypeMod+    , makeVmod_1_1_inv, makeVmod_1_1+    , makeVmod_2_1_inv, makeVmod_2_1+    , makeVmod_2_0+    , makeVmod_2_2+    , makeVmod_N_1+    , DatatypeSub(..)+    )+where++import Swish.RDF.Ruleset+    ( Ruleset(..)+    , getRulesetAxiom, getRulesetRule+    )++import Swish.RDF.Rule+    ( Formula(..)+    , Rule(..)+    )++import Swish.Utils.Namespace+    ( ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( swishName )++import Swish.RDF.VarBinding+    ( VarBinding(..)+    , addVarBinding+    , VarBindingModify(..), OpenVarBindingModify, nullVarBindingModify+    )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , mapFindMaybe+    )++import Swish.Utils.ListHelpers+    ( flist+    , deleteIndex+    )++import Data.Maybe( isJust, catMaybes )++import Control.Monad( join, liftM )++------------------------------------------------------------+--  Datatype framework+------------------------------------------------------------++-- |Datatype wraps a 'DatatypeVal' value, hiding the value type that+--  is used only in implementations of the datatype.+--  Users see just the datatype name and associated ruleset.+--+data Datatype ex lb vn = forall vt . Datatype (DatatypeVal ex vt lb vn)++instance LookupEntryClass+        (Datatype ex lb vn) ScopedName (Datatype ex lb vn)+    where+    newEntry (_,dt) = dt+    keyVal dt       = (typeName dt, dt)++-- |Get type name from Datatype value+typeName :: Datatype ex lb vn -> ScopedName+typeName (Datatype dtv) = tvalName  dtv++-- |Get static rules from Datatype value+typeRules :: Datatype ex lb vn -> Ruleset ex+typeRules (Datatype dtv) = tvalRules dtv++-- |Make rules for Datatype value based on supplied expression+typeMkRules :: Datatype ex lb vn -> ex -> [Rule ex]+typeMkRules (Datatype dtv) = tvalMkRules dtv++-- |Make variable binding modifiers based on values supplied+typeMkModifiers :: Datatype ex lb vn -> [OpenVarBindingModify lb vn]+typeMkModifiers (Datatype dtv) = tvalMkMods dtv++-- |Get named axiom from Datatype value+getTypeAxiom :: ScopedName -> Datatype ex lb vn -> Maybe (Formula ex)+getTypeAxiom nam dt = getRulesetAxiom nam (typeRules dt)++-- |Get named rule from Datatype value+getTypeRule :: ScopedName -> Datatype ex lb vn -> Maybe (Rule ex)+getTypeRule  nam dt = getRulesetRule  nam (typeRules dt)++-- |Get canonical form of datatype value+typeMkCanonicalForm :: Datatype ex lb vn -> String -> Maybe String+typeMkCanonicalForm (Datatype dtv) = tvalMkCanonicalForm dtv++------------------------------------------------------------+--  DatatypeVal+------------------------------------------------------------++-- |DatatypeVal is a structure that defines a number of functions+--  and values that characterize the behaviour of a datatype.+--+--  A datatype is specified with respect to (polymophic in) a given+--  type of (syntactic) expression with which it may be used, and+--  a value type (whos existence is hidden as an existential type+--  within `DatatypeMap`.+--+--  (I tried hiding the value type with an internal existential+--  declaration, but that wouldn't wash.  Hence this two-part+--  structure with `Datatype` in which the internal detail+--  of the value type is hidden from users of the `Datatype` class.)+--+--  The datatype characteristic functions have two goals:+--+--  (1) to support the general datatype entailment rules defined by+--      the RDF semantics specification, and+--+--  (2) to define additional datatype-specific inference patterns by+--      means of which provide additional base functionality to+--      applications based on RDF inference.+--+--  Datatype-specific inferences are provided using the `DatatypeRel`+--  structure for a datatype, which allows a number of named relations+--  to be defined on datatype values, and provides mechanisms to+--  calculate missing values in a partially-specified member of+--  a relation.+--+--  Note that rules and variable binding modifiers that deal with+--  combined values of more than one datatype may be defined+--  separately.  Definitions in this module are generally applicable+--  only when using a single datatype.+--+--  An alternative model for datatype value calculations is inspired+--  by that introduced by CWM for arithmetic operations, e.g.+--+--  >     (1 2 3) math:sum ?x => ?x rdf:value 6+--+--  (where the bare integer @n@ here is shorthand for @\"n\"^^xsd:integer@).+--+--  Datatype-specific inference patterns are provided in two ways:+--+--  * by variable binding modifiers that can be combined with the+--    query results during forward- for backward-chaining of+--    inference rules, and+--+--  * by the definition of inference rulesets that involve+--    datatype values.+--+--  I believe the first method to be more flexible than the second,+--  in that it more readily supports forward and backward chaining,+--  but can be used only through the definition of new rules.+--+--  Type parameters:+--+--  [@ex@] is the type of expression with which the datatype may be used.+--+--  [@vt@] is the internal value type with which the labels are associated.+--+--  [@lb@] is the type of label that may be used as a variable in an+--         expression or rule.+--+--  [@vn@] is the type of node that may be used to carry a value in an+--         expression or rule.+--+data DatatypeVal ex vt lb vn = DatatypeVal+    { tvalName      :: ScopedName+                                -- ^Identifies the datatype, and also+                                --  its value space class.+    , tvalRules     :: Ruleset ex+                                -- ^A set of named expressions and rules+                                --  that are valid in in any theory that+                                --  recognizes the current datatype.+    , tvalMkRules   :: ex -> [Rule ex]+                                -- ^A function that accepts an expression+                                --  and devives some datatype-dependent+                                --  rules from it.  This is provided as a+                                --  hook for creating datatyped class+                                --  restriction rules.+    , tvalMkMods    :: [OpenVarBindingModify lb vn]+                                -- ^Constructs a list of open variable+                                --  binding modifiers based on tvalMod,+                                --  but hiding the actual value type.+    , tvalMap       :: DatatypeMap vt+                                -- ^Lexical to value mapping, where @vt@ is+                                --  a datatype used within a Haskell program+                                --  to represent and manipulate values in+                                --  the datatype's value space+    , tvalRel       :: [DatatypeRel vt]+                                -- ^A set of named relations on datatype+                                --  values.  Each relation accepts a list+                                --  of @Maybe vt@, and computes any+                                --  unspecified values that are in the+                                --  relation with values supplied.+    , tvalMod       :: [DatatypeMod vt lb vn]+                                -- ^A list of named values that are used to+                                --  construct variable binding modifiers, which+                                --  in turn may be used by a rule definition.+                                --+                                --  TODO: In due course, this value may be+                                --  calculated automatically from the supplied+                                --  value for @tvalRel@.+    }++--  Other accessor functions++getDTRel ::+    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeRel vt)+getDTRel nam dtv =+    mapFindMaybe nam (LookupMap (tvalRel dtv))++getDTMod ::+    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeMod vt lb vn)+getDTMod nam dtv =+    mapFindMaybe nam (LookupMap (tvalMod dtv))++-- |Get canonical form of datatype value, or @Nothing@.+--+tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> String -> Maybe String+tvalMkCanonicalForm dtv str = can+    where+      dtmap = tvalMap dtv+      val   = mapL2V dtmap str+      can   = join $ liftM (mapV2L dtmap) val++-- |DatatypeMap consists of methods that perform lexical-to-value+--  and value-to-canonical-lexical mappings for a datatype.+--+--  The datatype mappings apply to string lexical forms.+--+data DatatypeMap vt = DatatypeMap+    { mapL2V  :: String -> Maybe vt+                            -- ^ Function to map lexical string to+                            --   datatype value.  This effectively+                            --   defines the lexical space of the+                            --   datatype to be all strings for which+                            --   yield a value other than @Nothing@.+    , mapV2L  :: vt -> Maybe String+                            -- ^ Function to map a value to its canonical+                            --   lexical form, if it has such.+    }++-- |Type for a datatype relation inference function.+--+--  A datatype relation defines tuples of values that satisfy some+--  relation.  A datatype relation inference function calculates+--  values that complete a relation with values supplied.+--+--  The function accepts a list of @Maybe vt@, where vt is the+--  datatype value type.  It returns one of:+--+--  * Just a list of lists, where each inner list returned is a+--      complete set of values, including the values supplied, that+--      are in the relation.+--+--  * Just an empty list is returned if the supplied values are+--      insufficient to compute any complete sets of values in the+--      relation.+--+--  * Nothing if the supplied values are not consistent with+--      the relation.+--+type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]++-- |Type for datatype relation predicate:  accepts a list of values+--  and determines whether or not they satisfy the relation.+--+type DatatypeRelPr vt = [vt] -> Bool++-- |Datatype for a named relation on values of a datatype.+--+data DatatypeRel vt = DatatypeRel+    { dtRelName :: ScopedName+    , dtRelFunc :: DatatypeRelFn vt+    }++instance LookupEntryClass (DatatypeRel vt) ScopedName (DatatypeRel vt)+    where+    newEntry (_,relf) = relf+    keyVal dtrel = (dtRelName dtrel, dtrel)++-- |Datatype value modifier functions type+--+--  Each function accepts a list of values and returns a list of values.+--  The exact significance of the different values supplied and returned+--  depends on the variable binding pattern used (cf. 'ApplyModifier'),+--  but in all cases an empty list returned means that the corresponding+--  inputs are not consistent with the function and cannot be used.+--+type ModifierFn vn = [vn] -> [vn]++-- |Type of function used to apply a data value modifier to specified+--  variables in a supplied variable binding.  It also accepts the+--  name of the datatype modifier and carries it into the resulting+--  variable binding modifier.+--+--  (Note that @vn@ is not necessarily the same as @vt@, the datatype value+--  type:  the modifier functions may be lifted or otherwise adapted+--  to operate on some other type from which the raw data values are+--  extracted.)+--+type ApplyModifier lb vn =+    ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn++-- |Wrapper for data type variable binding modifier included in+--  a datatype value.+--+data DatatypeMod vt lb vn = DatatypeMod+    { dmName :: ScopedName+    , dmModf :: [ModifierFn vt]+    , dmAppf :: ApplyModifier lb vn+    }++instance LookupEntryClass+        (DatatypeMod vt lb vn) ScopedName (DatatypeMod vt lb vn)+    where+    newEntry (_,dmod) = dmod+    keyVal dmod = (dmName dmod, dmod)++-- |Null datatype value modifier+nullDatatypeMod :: DatatypeMod vt lb vn+nullDatatypeMod = DatatypeMod+    { dmName = swishName "nullDatatypeMod"+    , dmModf = []+    , dmAppf = nullAppf+    }+    where+        -- nullAppf :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn+        nullAppf nam _ lbs = (nullVarBindingModify lbs) { vbmName = nam }++{-+-- |Apply datatype variable binding modifier value to list of labels and+--  a variable binding.+applyDatatypeMod :: (Eq lb, Show lb, Eq vn, Show vn)+    => DatatypeMod vt lb vn -> OpenVarBindingModify lb vn+applyDatatypeMod dtmod = dmAppf dtmod (dmName dtmod) (dmModf dtmod)+-}++{-+dmName dtmod :: ScopedName+dmModf dtmod :: [ModifierFn vt]+             :: [[vt] -> [vt]]+dmAppf dtmod :: ApplyModifier lb vn+             :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn+             :: ScopedName -> [[vn] -> [vn]] -> OpenVarBindingModify lb vn+dmAppf dtmod (dmName dtmod)+             :: [[vn] -> [vn]] -> OpenVarBindingModify lb vn+-}++--------------------------------------------------------------+--  Functions for creating datatype variable binding modifiers+--------------------------------------------------------------++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a @1->1@ function and inverse, such+--  as negate.+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--        +--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (0) is @[x,y] -> [?]@, used as a filter (i.e. not creating any+--              new variable bindings), returning a non-empty list if @x@ and @y@+--              are in the appropriate relationship.+--+--          (1) is @[y] -> [x]@, used to perform the calculation in a forward+--              direction.+--+--          (2) is @[x] -> [y]@, used to perform the calculation in a backward+--              direction.  This may be the same as (2) (e.g. for negation)+--              or may be different (e.g. increment).+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.  (The intent is that a variable-free+--          value can be generated as a Curried function, and instantiated+--          for particular variables as required.)+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_1_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_1_1_inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1],[lb2]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2] vbind = selv     (f0 [v1,v2]) vbind+        app2 [Nothing,Just v2] vbind = addv lb1 (f1 [v2])    vbind+        app2 [Just v1,Nothing] vbind = addv lb2 (f2 [v1])    vbind+        app2 _                     _     = []+makeVmod_1_1_inv _ _ _ =+    error "makeVmod_1_1_inv: requires 3 functions and 2 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases when+--  the value mapping is a non-invertable @1->1@ injection, such as+--  absolute value.+--+--  [@nam@] is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@] are functions used to implement details of the variable+--          binding modifier:+--+--          (0) is @[x,y] -> [?]@, used as a filter (i.e. not creating any+--              new variable bindings), returning a non-empty list if @x@ and @y@+--              are in the appropriate relationship.+--+--          (1) is @[x]@ -> @[y]@, used to perform the calculation.+--+--  [@lbs@] is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_1_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_1_1 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2] vbind = selv (f0 [v1,v2])  vbind+        app2 [Nothing,Just v2] vbind = addv lb1 (f1 [v2]) vbind+        app2 _                     _     = []+makeVmod_1_1 _ _ _ =+    error "makeVmod_1_1: requires 2 functions and 2 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a @2->1@ invertable function, such as+--  addition or subtraction.+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (1) is @[x,y,z] -> [?]@, used as a filter (i.e. not creating any+--              new variable bindings), returning a non-empty list if+--              @x@, @y@ and @z@ are in the appropriate relationship.+--+--          (2) is @[y,z] -> [x]@, used to perform the calculation in a+--              forward direction.+--+--          (3) is @[x,z] -> [y]@, used to run the calculation backwards to+--              determine the first input argument+--+--          (4) is @[x,y] -> [z]@, used to run the calculation backwards to+--              determine the second input argument+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_2_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_2_1_inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1],[lb2],[lb3]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2,Just v3] vbind = selv (f0 [v1,v2,v3]) vbind+        app2 [Nothing,Just v2,Just v3] vbind = addv lb1 (f1 [v2,v3]) vbind+        app2 [Just v1,Nothing,Just v3] vbind = addv lb2 (f2 [v1,v3]) vbind+        app2 [Just v1,Just v2,Nothing] vbind = addv lb3 (f3 [v1,v2]) vbind+        app2 _                               _     = []+makeVmod_2_1_inv _ _ _ =+    error "makeVmod_2_1_inv: requires 4 functions and 3 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a @2->1@ non-invertable function, such as+--  logical @AND@ or @OR@.+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (1) is @[x,y,z] -> [?]@, used as a filter (i.e. not creating any+--              new variable bindings), returning a non-empty list if+--              @x@, @y@ and @z@ are in the appropriate relationship.+--+--          (2) is @[y,z] -> [x]@, used to perform the calculation in a+--              forward direction.+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_2_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_2_1 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2,Just v3] vbind = selv (f0 [v1,v2,v3]) vbind+        app2 [Nothing,Just v2,Just v3] vbind = addv lb1 (f1 [v2,v3]) vbind+        app2 _                               _     = []+makeVmod_2_1 _ _ _ =+    error "makeVmod_2_1: requires 2 functions and 3 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a simple comparson of two values.+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (1) is @[x,y] -> [?]@, used as a filter (i.e. not creating any+--              new variable bindings), returning a non-empty list if+--              @x@ and @y@ are in the appropriate relationship.+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_2_0 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_2_0 nam [f0] lbs@(~[_,_]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2] vbind = selv (f0 [v1,v2]) vbind+        app2 _                     _     = []+makeVmod_2_0 _ _ _ =+    error "makeVmod_2_0: requires 1 function and 2 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a @2->2@ non-invertable function, such as+--  quotient/remainder+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (1) is @[w,x,y,z] -> [?]@, used as a filter (i.e. not creating+--              any new variable bindings), returning a non-empty list if+--              @w@, @x@, @y@ and @z@ are in the appropriate relationship.+--+--          (2) is @[y,z] -> [w,x]@, used to perform the calculation given+--              two input values.+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+--  NOTE: this might be generalized to allow one of @w@ or @x@ to be+--  specified, and return null if it doesn't match the calculated value.+--+makeVmod_2_2 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_2_2 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1,lb2]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 [Just v1,Just v2,Just v3,Just v4] vbind =+            selv (f0 [v1,v2,v3,v4]) vbind+        app2 [Nothing,Nothing,Just v3,Just v4] vbind =+            addv2 lb1 lb2 (f1 [v3,v4]) vbind+        app2 _                               _     = []+makeVmod_2_2 _ _ _ =+    error "makeVmod_2_2: requires 2 functions and 4 labels"++-- |'ApplyModifier' function for use with 'DatatypeMod' in cases+--  when the value mapping is a @N->1@ function,+--  such as Sigma (sum) of a vector.+--+--  [@nam@]     is the name from the 'DatatypeMod' value that is carried into+--          the resulting variable binding modifier.+--+--  [@fns@]     are functions used to implement details of the variable+--          binding modifier:+--+--          (1) is @[x,y...] -> [?]@, used as a filter (i.e. not creating+--              any new variable bindings), returning a non-empty list if+--              @x@ and @y...@ are in the appropriate relationship.+--+--          (2) is @[y...] -> [x]@, used to perform the calculation.+--+--  [@lbs@]     is a list of specific label values for which a variable binding+--          modifier will be generated.+--+--  Note: an irrefutable pattern match for @lbs@ is used so that a name+--  for the 'VarBindingModify' value can be extracted using an undefined+--  label value.+--+makeVmod_N_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod_N_1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify+    { vbmName   = nam+    , vbmApply  = concatMap app1+    , vbmVocab  = lbs+    , vbmUsage  = [[],[lb1]]+    }+    where+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind+        app2 vs@(v1:_) vbind+            | isJust v1 && isJustvs = selv (f0 jvs) vbind+            | isJustvs              = addv lb1 (f1 jvs) vbind+            | otherwise             = []+            where+                isJustvs = all isJust vs+                jvs      = catMaybes vs+        app2 _ _ = error "app2 sent empty list" -- -Wall++makeVmod_N_1 _ _ _ =+    error "makeVmod_N_1: requires 2 functions and at 1 or more labels"++--------------------------------------------------------+--  Local helper functions for makeVmodXXX variants+--------------------------------------------------------++--  Add value to variable variable binding, if value is singleton list,+--  otherwise return empty list.+addv :: (Eq lb, Show lb, Eq vt, Show vt)+    => lb -> [vt] -> VarBinding lb vt+    -> [VarBinding lb vt]+addv lb [val] vbind = [addVarBinding lb val vbind]+addv _  _     _     = []++--  Add two entries to variable variable binding, if value supplied is+--  a doubleton list, otherwise return empty list.+addv2 :: (Eq lb, Show lb, Eq vt, Show vt)+    => lb -> lb -> [vt] -> VarBinding lb vt+    -> [VarBinding lb vt]+addv2 lb1 lb2 [val1,val2] vbind = [addVarBinding lb1 val1 $+                                   addVarBinding lb2 val2 vbind]+addv2 _   _   _           _     = []++--  If supplied value is non-empty list return supplied variable binding,+--  otherwise return empty list.+selv :: [vt] -> varBinding lb vt -> [varBinding lb vt]+selv [] _     = []+selv _  vbind = [vbind]++--------------------------------------------------------------+--  Functions for evaluating arguments in a datatype relation+--------------------------------------------------------------+--+--  altArgs is a generic function for evaluating datatype relation+--          values, based on suppied functions and argument values+--+--  UnaryFnDescr, UnaryFnApply and unaryFnApp:+--          are support types and function for using altArgs to+--          evaluate relations on unary functions (binary relations).+--+--  BinaryFnDescr, BinaryFnApply and binaryFnApp:+--          are support types and function for using altArgs to+--          evaluate relations on binary functions (3-way relations).+--+--  ListFnDescr, ListFnApply and listFnApp:+--          are support types and function for using altArgs to+--          evaluate relations on list functions (n-way relations),+--          where the first member of the list is the value of a+--          fold of a function over the rest of the list.+--+--  See experimental module spike-altargs.hs for test cases and+--  development steps for this function.++-- |Given a list of argument values and a list of functions for+--  calculating new values from supplied values, return a list+--  of argument values, or @Nothing@ if the supplied values are+--  inconsistent with the calculations specified.+--+--  Each list of values returned corresponds to a set of values that+--  satisfy the relation, consistent with the values supplied.+--+--  Functions are described as tuple consisting of:+--+--    (a) a predicate that the argument is required to satisfy+--+--    (b) a function to apply,+--+--    (c) a function to apply function (b) to a list of arguments+--+--    (d) argument list index values to which the function is applied.+--+--  Each supplied argument is of the form @Maybe a@, where the argument+--  has value type a.  @Nothing@ indicates arguments of unknown value.+--+--  The basic idea is that, for each argument position in the relation,+--  a function may be supplied to calculate that argument's possible values+--  from some combination of the other arguments.  The results calculated+--  in this way are compared with the original arguments provided:+--  if the values conflict then the relation is presumed to be+--  unsatisfiable with the supplied values, and @Nothing@ is returned;+--  if there are any calculated values for arguments supplied without+--  any values, then tbe calculated values are used.+--  If there are any arguments for which no values are supplied or+--  calculated, then the relation is presumed to be underdetermined,+--  and @Just []@ is returned.+--+--  [@fnss@] is a list of argument value predicates and+--          function descriptors.  The predicate indicates any+--          additional constraints on argument values (e.g. the result+--          of abs must be positive).  Use @(const True)@ for the predicate+--          associated with unconstrained relation arguments.+--          For each argument, a list of function descriptors is+--          supplied corresponding to alternative values (e.g. a square+--          relation would offer two alternative values for the root.)+--+--  [@apfn@] is a function that takes an argument value predicate,+--          a function descriptor and applies it to a supplied argument+--          list to return:+--          @Just a@ calculated list of one or more possible argument values,+--          @Just []@ indicating insufficient information provided, or+--          @Nothing@ indicating inconsistent information provided.+--          May be one of 'unaryFnApp', 'binaryFnApp', 'listFnApp' or+--          some other caller-supplied value.+--          The value used must match the type of @fnss@ used.+--+--  Returns a @'DatatypeRelFn' vt@ value that can be used as the+--  'dtRelFunc' component of a 'DatatypeRel' value.+--+altArgs :: (Eq vt)+    => DatatypeRelPr vt -> [(vt->Bool,[b])]+    -> ((vt->Bool)->b->[Maybe vt]->Maybe [vt])+    -> DatatypeRelFn vt+altArgs pr fnss apfn args = cvals4 cvals3+    where+        --  Calculate new value(s) for each argument from supplied values, and+        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.+        --    cvals1 :: [Maybe [vt]]+        cvals1 = flist (map (applyFdescToTuple apfn) fnss) args+        --  Merge calculated values with supplied arguments, and again+        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.+        --    cvals2 :: Maybe [[vt]]+        cvals2 = sequence $ mergeTupleVals (map fst fnss) args cvals1+        --  Map list of alternative values for each tuple member to+        --  a list of alternative tuples.+        cvals3 = liftM sequence cvals2+        --  Check each tuple against the supplied predicate.+        --  If any of the alternative tuples does not match the predicate+        --  then signal an inconsistency.+        cvals4 Nothing       = Nothing+        cvals4 cvs@(Just ts) = if all pr ts then cvs else Nothing++--  Perform alternative calculations for single result value+--  Each result value is a list of zero or more alternatives+--  that can be calculated from available parameters, or+--  Nothing if the available parameters are inconsistent.+--+--  apfn    is the function that actually applies an element of+--          the function descriptor to a tuple of Maybe arguments+--          (where Nothing is used to indicate an unknown value)+--  (p,fns) is a pair consisting of a value-checking predicate+--          for the corresponding tuple member, and a list of+--          function descriptors that each return one or more+--          values the tuple member, calculated from other values+--          that are present.  Just [] means no values are+--          calculated for this member, and Nothing means the+--          calculation has detected tuple values supplied that+--          are inconsistent with the datatype relation concerned.+--  args    is a tuple of Maybe tuple elements, (where Nothing+--          indicates an unknown value).+--+--  Returns Maybe a list of alternative values for the member,+--  Just [] to indicate insufficient information to calculate+--  any new values, and Nothing to indicate an inconsistency.+--+applyFdescToTuple ::+    ((vt->Bool)->b->[Maybe vt]->Maybe [vt]) -> (vt->Bool,[b]) -> [Maybe vt]+    -> Maybe [vt]+applyFdescToTuple apfn (p,fns) args =+    liftM concat $ sequence cvals+    where+        -- cvals :: [Maybe [vt]]+        cvals = flist (map (apfn p) fns) args++--  Merge calculated tuple values with supplied tuple, checking for consistency.+--+--  ps      predicates used for isolated validation of each tuple member+--  args    supplied tuple values, with Nothing for unknown values+--  cvals   list of alternative calculated values for each tuple member,+--          or Nothing if an inconsistency has been detected by the+--          tuple-calculation functions.  Note that this list may contain+--          more entries than args; the surplus entries are ignored+--          (see list functions for how this is used).+--+--  Returns a tuple of Maybe lists of values for each tuple member,+--  containing Nothing if an inconsistency has been detected in the+--  supplied values.+--+mergeTupleVals  :: (Eq a) => [a->Bool] -> [Maybe a] -> [Maybe [a]] -> [Maybe [a]]+mergeTupleVals _ _  (Nothing:_) = [Nothing]+mergeTupleVals (_:ps) (Nothing:a1s) (Just a2s:a2ss)+                             = Just a2s:mergeTupleVals ps a1s a2ss+mergeTupleVals (p:ps) (Just a1:a1s) (Just []:a2ss)+    | p a1                   = Just [a1]:mergeTupleVals ps a1s a2ss+    | otherwise              = [Nothing]+mergeTupleVals (p:ps) (Just a1:a1s) (Just a2s:a2ss)+    | p a1 && elem a1 a2s    = Just [a1]:mergeTupleVals ps a1s a2ss+    | otherwise              = [Nothing]+mergeTupleVals _ [] _        = []+mergeTupleVals _ _  _        = [Nothing]++-- |'altArgs' support for unary functions: function descriptor type+type UnaryFnDescr a = (a->a,Int)++-- |'altArgs' support for unary functions: function descriptor table type+type UnaryFnTable a = [(a->Bool,[UnaryFnDescr a])]++-- |'altArgs' support for unary functions: function applicator type+type UnaryFnApply a = (a->Bool) -> UnaryFnDescr a -> [Maybe a] -> Maybe [a]++-- |'altArgs' support for unary functions: function applicator+unaryFnApp :: UnaryFnApply a+unaryFnApp p (f1,n) args = apf (args!!n)+    where+        apf (Just a) = if p r then Just [r] else Nothing where r = f1 a+        apf Nothing  = Just []++-- |'altArgs' support for binary functions: function descriptor type+type BinaryFnDescr a = (a->a->a,Int,Int)++-- |'altArgs' support for binary functions: function descriptor table type+type BinaryFnTable a = [(a->Bool,[BinaryFnDescr a])]++-- |'altArgs' support for binary functions: function applicator type+type BinaryFnApply a =+    (a->Bool) -> BinaryFnDescr a -> [Maybe a] -> Maybe [a]++-- |'altArgs' support for binary functions: function applicator+binaryFnApp :: BinaryFnApply a+binaryFnApp p (f,n1,n2) args = apf (args!!n1) (args!!n2)+    where+        apf (Just a1) (Just a2) = if p r then Just [r] else Nothing+            where r = f a1 a2+        apf _ _  = Just []++-- |'altArgs' support for binary function with provision for indicating+--  inconsistent supplied values:  function descriptor type+type BinMaybeFnDescr a = (a->a->Maybe [a],Int,Int)++-- |'altArgs' support for binary function with provision for indicating+--  inconsistent supplied values:  function descriptor table type+type BinMaybeFnTable a = [(a->Bool,[BinMaybeFnDescr a])]++-- |'altArgs' support for binary function with provision for indicating+--  inconsistent supplied values:  function applicator type+type BinMaybeFnApply a =+    (a->Bool) -> BinMaybeFnDescr a -> [Maybe a] -> Maybe [a]++-- |'altArgs' support for binary function with provision for indicating+--  inconsistent supplied values:  function applicator+binMaybeFnApp :: BinMaybeFnApply a+binMaybeFnApp p (f,n1,n2) args = apf (args!!n1) (args!!n2)+    where+        apf (Just a1) (Just a2) = if pm r then r else Nothing+            where+                r = f a1 a2+                pm Nothing  = False+                pm (Just x) = all p x+        apf _ _  = Just []++-- |'altArgs' support for list functions (e.g. sum over list of args),+--  where first element of list is a fold over the rest of the list,+--  and remaining elements of list can be calculated in terms+--  of the result of the fold and the remaining elements+--+--  List function descriptor is+--+--  (a) list-fold function, f  (e.g. (+)+--        +--  (b) list-fold identity, z  (e.g. 0)+--        +--  (c) list-fold-function inverse, g (e.g. (-))+--        +--  (d) index of element to evaluate+--        +--  such that:+--        +--  >    (a `f` z) == (z `f` a) == a+--  >    (a `g` c) == b <=> a == b `f` c+--  >    (a `g` z) == a+--  >    (a `g` a) == z+--+--  and the result of the folded function does not depend on+--  the order that the list elements are processed.+--+--  NOTE:  the list of 'ListFnDescr' values supplied to 'altArgs' must+--  be at least as long as the argument list.  In many cases, Haskell+--  lazy evaluation can be used to supply an arbitrarily long list.+--  See test cases in spike-altargs.hs for an example.+--+--  Function descriptor type+type ListFnDescr a = (a->a->a,a,a->a->a,Int)++-- |Function table type+type ListFnTable a = [(a->Bool,[ListFnDescr a])]++-- |'altArgs' support for list functions:  function applicator type+type ListFnApply a = (a->Bool) -> ListFnDescr a -> [Maybe a] -> Maybe [a]++-- |'altArgs' support for list functions:  function applicator+listFnApp :: ListFnApply a+listFnApp p (f,z,g,n) (a0:args)+    | n == 0    =+        app $ foldr (apf f) (Just [z]) args+    | otherwise =+        app $ apf g a0 (foldr (apf f) (Just [z]) (args `deleteIndex` (n-1)))+    where+        apf :: (a->a->a) -> Maybe a -> Maybe [a] -> Maybe [a]+        apf fn (Just a1) (Just [a2]) = Just [fn a1 a2]+        apf _  _         _           = Just []+        +        -- app :: Maybe [a] -> Maybe [a]+        app Nothing      = Nothing+        app r@(Just [a]) = if p a then r else Nothing+        app _            = Just []++listFnApp _ _ [] = error "listFnApp called with an empty list" -- -Wall++--------------------------------------------------------+--  Datatype sub/supertype description+--------------------------------------------------------++-- |Describe a subtype/supertype relationship between a pair of datatypes.+--+--  Originally, I had this as a supertype field of the DatatypeVal structure,+--  but that suffered from some problems:+--+--  * supertypes may be introduced retrospectively,+--+--  * the relationship expressed with respect to a single datatype+--      cannot indicate hiow to do injections/restrictions between the+--      underlying value types.+--+--  [@ex@]      is the type of expression with which the datatype may be used.+--+--  [@lb@]      is the type of the variable labels used.+--+--  [@vn@]      is the type of value node used to contain a datatyped value+--+--  [@supvt@]   is the internal value type of the super-datatype+--+--  [@subvt@]   is the internal value type of the sub-datatype+--+data DatatypeSub ex lb vn supvt subvt = DatatypeSub+    { trelSup   :: DatatypeVal ex supvt lb vn+                                -- ^ Datatype that is a supertype of @trelSub@,+                                --   having value space @supvt@.+    , trelSub   :: DatatypeVal ex subvt lb vn+                                -- ^ Datatype that is a subtype of @trelSup@,+                                --   having value space @supvt@.+    , trelToSup :: subvt -> supvt+                                -- ^ Function that maps subtype value to+                                --   corresponding supertype value.+    , trelToSub :: supvt -> Maybe subvt+                                -- ^ Function that maps supertype value to+                                --   corresponding subtype value, if there+                                --   is such a value.+    }++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/GraphClass.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}++--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphClass+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiParamTypeClasses+--+--  This module defines a Labelled Directed Graph and Label classes,+--  and the Arc datatype.+--+--------------------------------------------------------------------------------++------------------------------------------------------------+-- Define LDGraph, arc and related classes and types+------------------------------------------------------------++module Swish.RDF.GraphClass+    ( LDGraph(..), replaceArcs+    , Label(..)+    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple+    , Selector+    , hasLabel, arcLabels+    )+where++import qualified Data.Foldable as F+import qualified Data.Traversable as T++import Data.List (union, (\\))++--------------------------------+--  Labelled Directed Graph class+--------------------------------+--+--  Minimum required implementation:  setArcs, getArcs+--+--  NOTE:  I wanted to declare this as a subclass of Functor, but+--  the constraint on the label type seems to prevent that.+--  So I've just declared specific instances to be Functors.+class (Eq (lg lb), Eq lb ) => LDGraph lg lb+    where+    --  empty graph+    --  emptyGr     :: lg lb    [[[TODO?]]]+    --  component-level operations+    setArcs     :: [Arc lb] -> lg lb -> lg lb       -- setarcs [arcs] in g2 -> g3+    getArcs     :: lg lb -> [Arc lb]                -- g1 -> [arcs]+    --  extract arcs from a graph+    extract     :: Selector lb -> lg lb -> lg lb    -- select f1 from g2 -> g3+    extract sel = update (filter sel)+    --  graph-level operations+    add         :: lg lb -> lg lb -> lg lb          -- g1 + g2 -> g3+    add    addg = update (union (getArcs addg))+    delete      :: lg lb -> lg lb -> lg lb          -- g2 - g1 -> g3+    delete delg = update (\\ getArcs delg)+    --  enumerate distinct labels contained in a graph+    labels      :: lg lb -> [lb]      -- g1 -> [labels]+    labels g    = foldl union [] (map arcLabels (getArcs g))+    --  enumerate distinct labels contained in a graph+    nodes       :: lg lb -> [lb]      -- g1 -> [labels]+    nodes g     = foldl union [] (map arcNodes (getArcs g))+    --  test for graph containment in another+    containedIn :: lg lb -> lg lb -> Bool           -- g1 <= g2?+    -- g1 update arcs in a graph using a supplied function:+    update      :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb+    update f g  = setArcs ( f (getArcs g) ) g++-- |Function to replace arcs in a graph with a given list of arcs+replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb+replaceArcs gr as = update (const as) gr++---------------+--  Label class+---------------+--+--  A label may have a fixed binding, which means that the label identifies (is) a+--  particular graph node, and different such labels are always distinct nodes.+--  Alternatively, a label may be unbound (variable), which means that it is a+--  placeholder for an unknown node label.  Unbound node labels are used as+--  graph-local identifiers for indicating when the same node appears in+--  several arcs.+--+--  For the purposes of graph-isomorphism testing, fixed labels are matched when they+--  are the same.  Variable labels may be matched with any other variable label.+--  Our definition of isomorphism (for RDF graphs) does not match variable labels+--  with fixed labels.++class (Eq lb, Show lb, Ord lb) => Label lb where+    labelIsVar  :: lb -> Bool           -- does this node have a variable binding?+    labelHash   :: Int -> lb -> Int     -- calculate hash of label using supplied seed+    getLocal    :: lb -> String         -- extract local id from variable node+    makeLabel   :: String -> lb         -- make label value given local id+    -- compare     :: lb -> lb -> Ordering+    -- compare l1 l2 = compare (show l1) (show l2)++------------+--  Arc type+------------++data Arc lb = Arc { asubj, apred, aobj :: lb }+    deriving (Eq, Functor, F.Foldable, T.Traversable)++arcSubj :: Arc lb -> lb+arcSubj = asubj++arcPred :: Arc lb -> lb+arcPred = apred++arcObj :: Arc lb -> lb+arcObj = aobj++arc :: lb -> lb -> lb -> Arc lb+arc = Arc++arcToTriple :: Arc lb -> (lb,lb,lb)+arcToTriple a = (asubj a,apred a,aobj a)++arcFromTriple :: (lb,lb,lb) -> Arc lb+arcFromTriple (s,p,o) = Arc s p o++instance Ord lb => Ord (Arc lb) where+  compare (Arc s1 p1 o1) (Arc s2 p2 o2)+    | cs /= EQ = cs+    | cp /= EQ = cp+    | otherwise = co+    where+      cs = compare s1 s2+      cp = compare p1 p2+      co = compare o1 o2++  (Arc s1 p1 o1) <= (Arc s2 p2 o2)+    | s1 /= s2 = s1 <= s2+    | p1 /= p2 = p1 <= p2+    | otherwise = o1 <= o2++instance (Show lb) => Show (Arc lb) where+    show (Arc lb1 lb2 lb3) =+        "("++ show lb1 ++","++ show lb2 ++","++ show lb3 ++")"++type Selector lb = Arc lb -> Bool++hasLabel :: (Eq lb) => lb -> Arc lb -> Bool+hasLabel lbv (Arc lb1 lb2 lb3) = lbv `elem` [lb1, lb2, lb3]++arcLabels :: Arc lb -> [lb]+arcLabels (Arc lb1 lb2 lb3) = [lb1,lb2,lb3]++arcNodes :: Arc lb -> [lb]+arcNodes (Arc lb1 _ lb3) = [lb1,lb3]++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/GraphMatch.hs view
@@ -0,0 +1,612 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphMatch+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses+--+--  This module contains graph-matching logic.+--+--  The algorithm used is derived from a paper on RDF graph matching+--  by Jeremy Carroll [1].+--+--  [1] <http://www.hpl.hp.com/techreports/2001/HPL-2001-293.html>+--+--------------------------------------------------------------------------------++module Swish.RDF.GraphMatch+      ( graphMatch,+        -- The rest exported for testing only+        LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..),+        ScopedLabel(..), makeScopedLabel, makeScopedArc,+        LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,+        labelIsVar, labelHash,+        mapLabelIndex, setLabelHash, newLabelMap,+        graphLabels, assignLabelMap, newGenerationMap,+        graphMatch1, graphMatch2, equivalenceClasses, reclassify+      ) where++import Swish.Utils.LookupMap+import Swish.Utils.ListHelpers+import Swish.Utils.MiscHelpers+-- import Swish.Utils.TraceHelpers( trace, traceShow )+import Swish.RDF.GraphClass+import Data.Ord (comparing)+import Data.List( nub, sortBy, partition )+import qualified Data.List++--------------------------+--  Label index value type+--------------------------+--++-- | LabelIndex is a unique value assigned to each label, such that+--  labels with different values are definitely different values+--  in the graph;  e.g. do not map to each other in the graph+--  bijection.  The first member is a generation counter that+--  ensures new values are distinct from earlier passes.++type LabelIndex = (Int,Int)++nullLabelVal :: LabelIndex+nullLabelVal = (0,0)++-----------------------+--  Label mapping types+-----------------------++data (Label lb) => GenLabelEntry lb lv = LabelEntry lb lv++type LabelEntry lb = GenLabelEntry lb LabelIndex++instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)+    => LookupEntryClass (GenLabelEntry lb lv) lb lv where+    keyVal   (LabelEntry k v) = (k,v)+    newEntry (k,v)            = LabelEntry k v++instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)+    => Show (GenLabelEntry lb lv) where+    show = entryShow++instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)+    => Eq (GenLabelEntry lb lv) where+    (==) = entryEq++-- | Type for label->index lookup table+data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =+    LabelMap Int (LookupMap (GenLabelEntry lb lv))++type LabelMap lb = GenLabelMap lb LabelIndex++instance (Label lb) => Show (LabelMap lb) where+    show = showLabelMap++instance (Label lb) => Eq (LabelMap lb) where+    LabelMap gen1 lmap1 == LabelMap gen2 lmap2 =+        gen1 == gen2 && es1 `equiv` es2+        where+            es1 = listLookupMap lmap1+            es2 = listLookupMap lmap2++emptyMap :: (Label lb) => LabelMap lb+emptyMap = LabelMap 1 $ makeLookupMap []++--------------------------+--  Equivalence class type+--------------------------+--++-- | Type for equivalence class description+--  (An equivalence class is a collection of labels with+--  the same LabelIndex value.)++type EquivalenceClass lb = (LabelIndex,[lb])++{-+ecIndex :: EquivalenceClass lb -> LabelIndex+ecIndex = fst+-}++ecLabels :: EquivalenceClass lb -> [lb]+ecLabels = snd++{-+ecSize :: EquivalenceClass lb -> Int+ecSize = length . ecLabels+-}++ecRemoveLabel :: (Label lb) => EquivalenceClass lb -> lb -> EquivalenceClass lb+ecRemoveLabel (lv,ls) l = (lv,Data.List.delete l ls)++------------------------------------------------------------+--  Augmented graph label value - for graph matching+------------------------------------------------------------+--+-- | This instance of class label adds a graph identifier to+--  each variable label, so that variable labels from+--  different graphs are always seen as distinct values.+--+--  The essential logic added by this class instance is embodied+--  in the eq and hash functions.  Note that variable label hashes+--  depend only on the graph in which they appear, and non-variable+--  label hashes depend only on the variable.  Label hash values are+--  used when initializing a label equivalence-class map (and, for+--  non-variable labels, also for resolving hash collisions).++data (Label lb) => ScopedLabel lb = ScopedLabel Int lb++makeScopedLabel :: (Label lb) => Int -> lb -> ScopedLabel lb+makeScopedLabel = ScopedLabel ++makeScopedArc :: (Label lb) => Int -> Arc lb -> Arc (ScopedLabel lb)+makeScopedArc scope a1 = arc (s arcSubj a1) (s arcPred a1) (s arcObj a1)+    where+        s f a = ScopedLabel scope (f a)++instance (Label lb) => Label (ScopedLabel lb) where+    getLocal  lab    = error $ "getLocal for ScopedLabel: "++show lab+    makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam+    labelIsVar (ScopedLabel _ lab)   = labelIsVar lab+    labelHash seed (ScopedLabel scope lab)+        | labelIsVar lab    = hash seed $ show scope ++ "???"+        | otherwise         = labelHash seed lab++instance (Label lb) => Eq (ScopedLabel lb) where+    (ScopedLabel s1 l1) == (ScopedLabel s2 l2)+        = l1 == l2 && s1 == s2++instance (Label lb) => Show (ScopedLabel lb) where+    show (ScopedLabel s1 l1) = show s1 ++ ":" ++ show l1++instance (Label lb) => Ord (ScopedLabel lb) where+    compare (ScopedLabel s1 l1) (ScopedLabel s2 l2) =+        case compare s1 s2 of+            LT -> LT+            EQ -> compare l1 l2+            GT -> GT++-- QUS: why doesn't this return Maybe (LabelMap (ScopedLabel lb)) ?++-- | Graph matching function accepting two lists of arcs and+--  returning a node map if successful+--+graphMatch :: (Label lb) =>+    (lb -> lb -> Bool)+    -- ^ a function that tests for additional constraints+    --   that may prevent the matching of a supplied pair+    --   of nodes.  Returns `True` if the supplied nodes may be+    --   matched.  (Used in RDF graph matching for checking+    --   that formula assignments are compatible.)+    -> [Arc lb] -- ^ the first graph to be compared, as a list of arcs+    -> [Arc lb] -- ^ the second graph to be compared, as a list of arcs+    -> (Bool,LabelMap (ScopedLabel lb))+    -- ^ If the first element is `True` then the secondelement maps each label+    --   to an equivalence class identifier, otherwise it is just+    --   `emptyMap`.+    --+graphMatch matchable gs1 gs2 =+    let+        sgs1    = {- trace "sgs1 " $ -} map (makeScopedArc 1) gs1+        sgs2    = {- trace "sgs2 " $ -} map (makeScopedArc 2) gs2+        ls1     = {- traceShow "ls1 " $ -} graphLabels sgs1+        ls2     = {- traceShow "ls2 " $ -} graphLabels sgs2+        lmap    = {- traceShow "lmap " $ -}+                  newGenerationMap $+                  assignLabelMap ls1 $+                  assignLabelMap ls2 emptyMap+        ec1     = {- traceShow "ec1 " $ -} equivalenceClasses lmap ls1+        ec2     = {- traceShow "ec2 " $ -} equivalenceClasses lmap ls2+        ecpairs = zip (pairSort ec1) (pairSort ec2)+        matchableScoped (ScopedLabel _ l1) (ScopedLabel _ l2) = matchable l1 l2+        match   = graphMatch1 False matchableScoped sgs1 sgs2 lmap ecpairs+    in+        if length ec1 /= length ec2 then (False,emptyMap) else match++-- | Recursive graph matching function+--+--  This function assumes that no variable label appears in both graphs.+--  (Function `graphMatch`, which calls this, ensures that all variable+--  labels are distinct.)+--+--  TODO:+--+--    * replace Equivalence class pair by @(index,[lb],[lb])@ ?+--+--    * possible optimization:  the `graphMapEq` test should be+--      needed only if `graphMatch2` has been used to guess a+--      mapping;  either: +--          a) supply flag saying guess has been used, or+--          b) move test to `graphMatch2` and use different+--             test to prevent rechecking for each guess used.+--++graphMatch1 :: +  (Label lb) +  => Bool+  -- ^ `True` if a guess has been used before trying this comparison,+  --   `False` if nodes are being matched without any guesswork+  -> (lb -> lb -> Bool)+  -- ^ Test for additional constraints that may prevent the matching+  --  of a supplied pair of nodes.  Returns `True` if the supplied+  --  nodes may be matched.+  -> [Arc lb] +  -- ^ (@gs1@ argument)+  --   first of two lists of arcs (triples) to be compared+  -> [Arc lb]+  -- ^ (@gs2@ argument)+  --   secind of two lists of arcs (triples) to be compared+  -> LabelMap lb+  -- ^ the map so far used to map label values to equivalence class+  --   values+  -> [(EquivalenceClass lb,EquivalenceClass lb)]+  -- ^ (the @ecpairs@ argument) list of pairs of corresponding+  --   equivalence classes of nodes from @gs1@ and @gs2@ that have not+  --   been confirmed in 1:1 correspondence with each other.  Each+  --   pair of equivalence classes contains nodes that must be placed+  --   in 1:1 correspondence with each other.+  --+  -> (Bool,LabelMap lb)+  -- ^ the pair @(match, map)@ where @match@ is @True@ if the supplied+  --   sets of arcs can be matched, in which case @map@ is a+  --   corresponding map from labels to equivalence class identifiers.+  --   When @match@ is @False@, @map@ is the most detailed equivalence+  --   class map obtained before a mismatch was detected or a guess+  --   was required -- this is intended to help identify where the+  --   graph mismatch may be.+graphMatch1 guessed matchable gs1 gs2 lmap ecpairs =+    let+        (secs,mecs) = partition uniqueEc ecpairs+        uniqueEc ( (_,[_])  , (_,[_])  ) = True+        uniqueEc (  _       ,  _       ) = False+        +        doMatch  ( (_,[l1]) , (_,[l2]) ) = labelMatch matchable lmap l1 l2+        doMatch  x = error $ "doMatch failue: " ++ show x -- keep -Wall happy++        ecEqSize ( (_,ls1)  , (_,ls2)  ) = length ls1 == length ls2+        eSize    ( (_,ls1)  , _        ) = length ls1+        ecCompareSize = comparing eSize+        (lmap',mecs',newEc,matchEc) = reclassify gs1 gs2 lmap mecs+        match2 = graphMatch2 matchable gs1 gs2 lmap $ sortBy ecCompareSize mecs+    in+        -- trace ("graphMatch1\nsingle ECs:\n"++show secs+++        --                   "\nmultiple ECs:\n"++show mecs+++        --                   "\n\n") $+        --  if mismatch in singleton equivalence classes, fail+        if not $ all doMatch secs then (False,lmap)+        else+        --  if no multi-member equivalence classes,+        --  check and return label map supplied+        -- trace ("graphMatch1\ngraphMapEq: "++show (graphMapEq lmap gs1 gs2)) $+        if null mecs then (graphMapEq lmap gs1 gs2,lmap)+        else+        --  if size mismatch in equivalence classes, fail+        -- trace ("graphMatch1\nall ecEqSize mecs: "++show (all ecEqSize mecs)) $+        +          --  invoke reclassification, and deal with result+          if not (all ecEqSize mecs) || not matchEc+            then (False, lmap)+            else if newEc+                   then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'+                        --  if guess does not result in a match, return supplied label map+                   else if fst match2 then match2 else (False, lmap)++{-+          if not $ all ecEqSize mecs then (False,lmap)+        else+        if not matchEc then (False,lmap)+        else+        if newEc then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'+        else+        if fst match2 then match2 else (False,lmap)+-}++-- | Auxiliary graph matching function+--+--  This function is called when deterministic decomposition of node+--  mapping equivalence classes has run its course.+--+--  It picks a pair of equivalence classes in ecpairs, and arbitrarily matches+--  pairs of nodes in those equivalence classes, recursively calling the+--  graph matching function until a suitable node mapping is discovered+--  (success), or until all such pairs have been tried (failure).+--+--  This function represents a point to which arbitrary choices are backtracked.+--  The list comprehension 'glp' represents the alternative choices at the+--  point of backtracking+--+--  The selected pair of nodes are placed in a new equivalence class based on their+--  original equivalence class value, but with a new NodeVal generation number.++graphMatch2 :: (Label lb) => (lb -> lb -> Bool)+    -> [Arc lb] -> [Arc lb]+    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]+    -> (Bool,LabelMap lb)+graphMatch2 _         _   _   _    [] = error "graphMatch2 sent an empty list" -- To keep -Wall happy+graphMatch2 matchable gs1 gs2 lmap ((ec1@(ev1,ls1),ec2@(ev2,ls2)):ecpairs) =+    let+        v1 = snd ev1+        --  Return any equivalence-mapping obtained by matching a pair+        --  of labels in the supplied list, or Nothing.+        try []            = (False,lmap)+        try ((l1,l2):lps) = if isEquiv try1 l1 l2 then try1 else try lps+            where+                try1     = graphMatch1 True matchable gs1 gs2 lmap' ecpairs'+                lmap'    = newLabelMap lmap [(l1,v1),(l2,v1)]+                ecpairs' = ((ev',[l1]),(ev',[l2])):ec':ecpairs+                ev'      = mapLabelIndex lmap' l1+                ec'      = (ecRemoveLabel ec1 l1, ecRemoveLabel ec2 l2)+                -- [[[TODO: replace this: if isJust try ?]]]+                isEquiv (False,_)   _  _  = False+                isEquiv (True,lm) x1 x2 =+                    mapLabelIndex m1 x1 == mapLabelIndex m2 x2+                    where+                        m1 = remapLabels gs1 lm [x1]+                        m2 = remapLabels gs2 lm [x2]+        --  glp is a list of label-pair candidates for matching,+        --  selected from the first label-equivalence class.+        --  NOTE:  final test is call of external matchable function+        glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ]+    in+        assert (ev1==ev2) "GraphMatch2: Equivalence class value mismatch" $+        try glp++-- | Returns a string representation  of a LabelMap value+--+showLabelMap :: (Label lb) => LabelMap lb -> String+showLabelMap (LabelMap gn lmap) =+    "LabelMap gen="++ Prelude.show gn ++", map="+++    foldl (++) "" (map (("\n    "++) . Prelude.show) es)+    where+        es = listLookupMap lmap++-- | Map a label to its corresponding label index value in the supplied LabelMap+--+mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex+mapLabelIndex (LabelMap _ lxms) lb = mapFind nullLabelVal lb lxms++-- | Confirm that a given pair of labels are matchable, and are+--  mapped to the same value by the supplied label map+--+labelMatch :: (Label lb)+    =>  (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool+labelMatch matchable lmap l1 l2 =+    matchable l1 l2 && (mapLabelIndex lmap l1 == mapLabelIndex lmap l1)++-- | Replace selected values in a label map with new values from the supplied+--  list of labels and new label index values.  The generation number is+--  supplied from the current label map.  The generation number in the+--  resulting label map is incremented.+--+newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb+newLabelMap (LabelMap g f) [] = LabelMap (g+1) f -- new generation+newLabelMap lmap (lv:lvs)     = setLabelHash (newLabelMap lmap lvs) lv++-- | Replace a label and its associated value in a label map+--  with a new value using the supplied hash value and the current+--  `LabelMap` generation number.  If the key is not found, then no change+--  is made to the label map.++setLabelHash :: (Label lb)+    => LabelMap lb -> (lb,Int) -> LabelMap lb+setLabelHash  (LabelMap g lmap) (lb,lh) =+    LabelMap g ( mapReplaceAll lmap $ newEntry (lb,(g,lh)) )++-- | Increment the generation of the label map.+--+--  Returns a new label map identical to the supplied value+--  but with an incremented generation number.+--+newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb+newGenerationMap (LabelMap g lvs) = LabelMap (g+1) lvs++-- | Scan label list, assigning initial label map values,+--  adding new values to the label map supplied.+--+--  Label map values are assigned on the basis of the+--  label alone, without regard for it's connectivity in+--  the graph.  (cf. `reclassify`).+--+--  All variable node labels are assigned the same initial+--  value, as they may be matched with each other.+--+assignLabelMap :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb+assignLabelMap ns lmap = foldl (flip assignLabelMap1) lmap ns++assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb+assignLabelMap1 lab (LabelMap g lvs) = LabelMap g lvs'+    where+        lvs' = mapAddIfNew lvs $ newEntry (lab,(g,initVal lab))++--  Calculate initial value for a node++initVal :: (Label lb) => lb -> Int+initVal = hashVal 0++hashVal :: (Label lb) => Int -> lb -> Int+hashVal seed lab =+    if labelIsVar lab then hash seed "???" else labelHash seed lab++equivalenceClasses :: +  (Label lb) +  => LabelMap lb -- ^ label map+  -> [lb]        -- ^ list of nodes to be reclassified+  -> [EquivalenceClass lb]+  -- ^ the equivalence classes of the supplied labels under the+  --   supplied label map+equivalenceClasses lmap ls =+    pairGroup $ map labelPair ls+    where+        labelPair l = (mapLabelIndex lmap l,l)++-- | Reclassify labels+--+--  Examines the supplied label equivalence classes (based on the supplied+--  label map), and evaluates new equivalence subclasses based on node+--  values and adjacency (for variable nodes) and rehashing+--  (for non-variable nodes).+--+--  Note, assumes that all all equivalence classes supplied are+--  non-singletons;  i.e. contain more than one label.+--+reclassify :: +  (Label lb) +  => [Arc lb] +  -- ^ (the @gs1@ argument) the first of two lists of arcs (triples) to perform a+  --   basis for reclassifying the labels in the first equivalence+  --   class in each pair of @ecpairs@.+  -> [Arc lb]+  -- ^ (the @gs2@ argument) the second of two lists of arcs (triples) to perform a+  --   basis for reclassifying the labels in the second equivalence+  --   class in each pair of the @ecpairs@ argument+  -> LabelMap lb +  -- ^ the label map used for classification of the labels in+  --   the supplied equivalence classes+  -> [(EquivalenceClass lb,EquivalenceClass lb)]+  -- ^ (the @ecpairs@ argument) a list of pairs of corresponding equivalence classes of+  --   nodes from @gs1@ and @gs2@ that have not been confirmed+  --   in 1:1 correspondence with each other.+  -> (LabelMap lb,[(EquivalenceClass lb,EquivalenceClass lb)],Bool,Bool)+  -- ^ The output tuple consists of:+  --+  --  1) a revised label map reflecting the reclassification+  --+  --  2) a new list of equivalence class pairs based on the+  --   new node map+  --+  --  3) if the reclassification partitions any of the+  --     supplied equivalence classes then `True`, else `False`+  --+  --  4) if reclassification results in each equivalence class+  --     being split same-sized equivalence classes in the two graphs,+  --     then `True`, otherwise `False`.++reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =+    assert (gen1==gen2) "Label map generation mismatch"+      (LabelMap gen1 lm',ecpairs',newPart,matchPart)+    where+        LabelMap gen1 lm1 =+            remapLabels gs1 lmap $ foldl1 (++) $ map (ecLabels . fst) ecpairs+        LabelMap gen2 lm2 =+            remapLabels gs2 lmap $ foldl1 (++) $ map (ecLabels . snd) ecpairs+        lm' = mapReplaceMap lm $ mapMerge lm1 lm2+        -- ecGroups :: [([EquivalenceClass lb],[EquivalenceClass lb])]+        ecGroups  = [ (remapEc ec1,remapEc ec2) | (ec1,ec2) <- ecpairs ]+        ecpairs'  = concatMap (uncurry zip) ecGroups+        newPart   = any pairG1 lenGroups+        matchPart = all pairEq lenGroups+        lenGroups = map subLength ecGroups+        pairEq (p1,p2) = p1 == p2+        pairG1 (p1,p2) = p1 > 1 || p2 > 1+        subLength (ls1,ls2) = (length ls1,length ls2)+        remapEc ec = pairGroup $ map (newIndex lm') $ pairUngroup ec+        newIndex x (_,lab) = (mapFind nullLabelVal lab x,lab)++-- | Calculate a new index value for a supplied list of labels based on the+--  supplied label map and adjacency calculations in the supplied graph+--+remapLabels :: +  (Label lb) +  => [Arc lb] -- ^ arcs used for adjacency calculations when remapping+  -> LabelMap lb -- ^ the current label index values+  -> [lb] -- ^ the graph labels for which new mappings are to be created+  -> LabelMap lb+  -- ^ the updated label map containing recalculated label index values+  -- for the given graph labels. The label map generation number is+  -- incremented by 1.+remapLabels gs lmap@(LabelMap gen _) ls =+    LabelMap gen' (LookupMap newEntries)+    where+        gen'                = gen+1+        newEntries          = [ newEntry (l, (gen',newIndex l)) | l <- ls ]+        newIndex l+            | labelIsVar l  = mapAdjacent l     -- adjacency classifies variable labels+            | otherwise     = hashVal gen l     -- otherwise rehash (to disentangle collisions)+        mapAdjacent l       = sum (sigsOver l) `rem` hashModulus+        sigsOver l          = select (hasLabel l) gs (arcSignatures lmap gs)++-- | Return list of distinct labels used in a graph++graphLabels :: (Label lb) => [Arc lb] -> [lb]+graphLabels gs = nub $ concatMap arcLabels gs++{-  OLD CODE:+graphLabels gs = graphLabels1 gs []++graphLabels1 (t:gs) ls = graphLabels1 gs $+                         foldl (flip addSetElem) ls (arcLabels t)+graphLabels1 [] ls     = ls+-}++-- addSetElem ::  lb -> [lb] -> [lb]++-- | Calculate a signature value for each arc that can be used in constructing an+--   adjacency based value for a node.  The adjacancy value for a label is obtained+--   by summing the signatures of all statements containing that label.+--+arcSignatures :: +  (Label lb) +  => LabelMap lb -- ^ the current label index values+  -> [Arc lb] -- ^ calculate signatures for these arcs+  -> [Int] -- ^ the signatures of the arcs+arcSignatures lmap gs =+    map (sigCalc . arcToTriple) gs+    where+        sigCalc (s,p,o)  =+            ( labelVal2 s ++              labelVal2 p * 3 ++              labelVal2 o * 5 ) `rem` hashModulus+        labelVal         = mapLabelIndex lmap+        labelVal2        = uncurry (*) . labelVal++-- | Return a new graph that is supplied graph with every node/arc+--  mapped to a new value according to the supplied function.+--+--  Used for testing for graph equivalence under a supplied+--  label mapping;  e.g.+--+--  >  if ( graphMap nodeMap gs1 ) `equiv` ( graphMap nodeMap gs2 ) then (same)+--+graphMap :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc LabelIndex]+graphMap = map . fmap . mapLabelIndex  -- graphMapStmt++-- | Compare a pair of graphs for equivalence under a given mapping+--   function.+--+--  This is used to perform the ultimate test that two graphs are+--  indeed equivalent:  guesswork in `graphMatch2` means that it is+--  occasionally possible to construct a node mapping that generates+--  the required singleton equivalence classes, but does not fully+--  reflect the topology of the graphs.++graphMapEq :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc lb] -> Bool+graphMapEq lmap gs1 gs2 = graphMap lmap gs1 `equiv` graphMap lmap gs2++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/GraphMem.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}++--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphMem+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleInstances, MultiParamTypeClasses+--+--  This module defines a simple memory-based graph instance.+--+--------------------------------------------------------------------------------++------------------------------------------------------------+-- Simple labelled directed graph value+------------------------------------------------------------++module Swish.RDF.GraphMem+    ( GraphMem(..)+    , setArcs, getArcs, add, delete, extract, labels+    , LabelMem(..)+    , labelIsVar, labelHash+      -- For debug/test:+    , matchGraphMem+    ) where++import Swish.RDF.GraphClass+import Swish.RDF.GraphMatch+import Swish.Utils.MiscHelpers+    ( hash )++import Data.Ord (comparing)++import qualified Data.Foldable as F+import qualified Data.Traversable as T++-- | Memory-based graph type ++data GraphMem lb = GraphMem { arcs :: [Arc lb] }+                   deriving (Functor, F.Foldable, T.Traversable)+                            +instance (Label lb) => LDGraph GraphMem lb where+    getArcs      = arcs+    setArcs as g = g { arcs=as }+    -- gmap f g = g { arcs = (map $ fmap f) (arcs g) }+    containedIn = undefined -- TODO: what should this method do?++instance (Label lb) => Eq (GraphMem lb) where+    (==) = graphEq++instance (Label lb) => Show (GraphMem lb) where+    show = graphShow++graphShow   :: (Label lb) => GraphMem lb -> String+graphShow g = "Graph:" ++ foldr ((++) . ("\n    " ++) . show) "" (arcs g)++{-+toGraph :: (Label lb) => [Arc lb] -> GraphMem lb+toGraph as = GraphMem { arcs=nub as }+-}++-- |  Return Boolean graph equality++graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool+graphEq g1 g2 = fst ( matchGraphMem g1 g2 )++-- | GraphMem matching function accepting GraphMem value and returning+--  node map if successful+--+matchGraphMem ::+  (Label lb)+  => GraphMem lb +  -> GraphMem lb+  -> (Bool,LabelMap (ScopedLabel lb))+  -- ^ if the first element is @True@ then the second value is a label+  --   map that maps each label to an equivalence-class identifier,+  --   otherwise `emptyMap`.+  --+matchGraphMem g1 g2 =+    let+        gs1     = arcs g1+        gs2     = arcs g2+        matchable l1 l2+            | labelIsVar l1 && labelIsVar l2 = True+            | labelIsVar l1 || labelIsVar l2 = False+            | otherwise                      = l1 == l2+    in+        graphMatch matchable gs1 gs2++{-+-- |  Return bijection between two graphs, or empty list+graphBiject :: (Label lb) => GraphMem lb -> GraphMem lb -> [(lb,lb)]+graphBiject g1 g2 = if null lmap then [] else zip (sortedls g1) (sortedls g2)+    where+        lmap        = graphMatch g1 g2+        sortedls g  = map snd $+                      (sortBy indexComp) $+                      equivalenceClasses (graphLabels $ arcs g) lmap+        classComp ec1 ec2 = indexComp (classIndexVal ec1) (classIndexVal ec2)+        indexComp (g1,v1) (g2,v2)+            | g1 == g2  = compare v1 v2+            | otherwise = compare g1 g2+-}++-- |  Minimal graph label value - for testing++data LabelMem+    = LF String+    | LV String++instance Label LabelMem where+    labelIsVar (LV _)   = True+    labelIsVar _        = False+    getLocal   (LV loc) = loc+    getLocal   lab      = error "getLocal of non-variable label: " ++ show lab+    makeLabel           = LV +    labelHash  seed lb  = hash seed (show lb)++instance Eq LabelMem where+    (LF l1) == (LF l2)  = l1 == l2+    (LV l1) == (LV l2)  = l1 == l2+    _ == _              = False++instance Show LabelMem where+    show (LF l1)        = '!' : l1+    show (LV l2)        = '?' : l2++instance Ord LabelMem where+    compare = comparing show ++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/GraphPartition.hs view
@@ -0,0 +1,572 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphPartition+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains functions for partitioning a graph into subgraphs+--  that rooted from different subject nodes.+--+--------------------------------------------------------------------------------++module Swish.RDF.GraphPartition+    ( PartitionedGraph(..), getArcs, getPartitions+    , GraphPartition(..), node, toArcs+    , partitionGraph, comparePartitions+    , partitionShowP+    )+where++import Swish.RDF.GraphClass+    ( Label(..)+    , Arc(..), arcSubj, arcObj, +    -- , hasLabel, arcLabels+    )++import Data.List+    ( partition )++import Control.Monad.State+    ( MonadState(..), State, evalState )++import Data.Maybe+    ( isJust, fromJust, mapMaybe )+++------------------------------------------------------------+--  Data type for a partitioned graph+------------------------------------------------------------++-- |Representation of a graph as a collection of (possibly nested)+--  partitions.  Each node in the graph appears at least once as the+--  root value of a 'GraphPartition' value:+--+--  * Nodes that are the subject of at least one statement appear as+--    the first value of exactly one 'PartSub' constructor, and may+--    also appear in any number of 'PartObj' constructors.+--+--  * Nodes appearing only as objects of statements appear only in+--    'PartObj' constructors.++data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]+    deriving (Eq,Show)++getArcs :: PartitionedGraph lb -> [Arc lb]+getArcs (PartitionedGraph ps) = concatMap toArcs ps++getPartitions :: PartitionedGraph lb -> [GraphPartition lb]+getPartitions (PartitionedGraph ps) = ps++-- QUS: is the list always guaranteed to be non-empty in PartSub?+data GraphPartition lb+    = PartObj lb+    | PartSub lb [(lb,GraphPartition lb)]++node :: GraphPartition lb -> lb+node (PartObj ob)   = ob+node (PartSub sb _) = sb++toArcs :: GraphPartition lb -> [Arc lb]+toArcs (PartObj _)      = []+toArcs (PartSub sb prs) = concatMap toArcs1 prs+    where+        toArcs1 (pr,ob) = Arc sb pr (node ob) : toArcs ob++instance (Label lb) => Eq (GraphPartition lb) where+    (==) = partitionEq++instance (Label lb) => Show (GraphPartition lb) where+    show = partitionShow++--  Equality is based on total structural equivalence.+--  This is not the same as graph equality.+partitionEq :: (Label lb) => GraphPartition lb -> GraphPartition lb -> Bool+partitionEq (PartObj o1)    (PartObj o2)    = o1 == o2+partitionEq (PartSub s1 p1) (PartSub s2 p2) = s1 == s2 && p1 == p2+partitionEq  _               _              = False++partitionShow :: (Label lb) => GraphPartition lb -> String+partitionShow (PartObj ob)          = show ob+partitionShow (PartSub sb [])       = "(" ++ show sb ++ ")" -- just to make -Wall happy, is this sensible?+partitionShow (PartSub sb (pr:prs)) =+    "("++ show sb ++ " " ++ showpr pr ++ concatMap ((" ; "++).showpr) prs ++ ")"+    where+        showpr (a,b) = show a ++ " " ++ show b+  +partitionShowP :: (Label lb) => String -> GraphPartition lb -> String+partitionShowP _    (PartObj ob)          = show ob+partitionShowP pref (PartSub sb [])       = pref ++ "(" ++ show sb ++ ")" -- just to make -Wall happy, is this sensible?+partitionShowP pref (PartSub sb (pr:prs)) =+    pref++"("++ show sb ++ " " ++ showpr pr ++ concatMap (((pref++"  ; ")++).showpr) prs ++ ")"+    where+        showpr (a,b) = show a ++ " " ++ partitionShowP (pref++"  ") b++------------------------------------------------------------+--  Creating partitioned graphs+------------------------------------------------------------+--+-- |Turning a partitioned graph into a flat graph is easy.+--  The interesting challenge is to turn a flat graph into a+--  partitioned graph that is more useful for certain purposes.+--  Currently, I'm interested in:+--        +--  (1) isolating differences between graphs+--        +--  (2) pretty-printing graphs+--+--  For (1), the goal is to separate subgraphs that are known+--  to be equivalent from subgraphs that are known to be different,+--  such that: +--+--  * different sub-graphs are minimized,+--+--  * different+--  sub-graphs are placed into 1:1 correspondence (possibly with null+--  subgraphs), and+--+--  * only deterministic matching decisions are made.+--+--  For (2), the goal is to decide when a subgraph is to be treated+--  as nested in another partition, or treated as a new top-level partition.+--  If a subgraph is referenced by exactly one graph partition, it should+--  be nested in that partition, otherwise it should be a new top-level+--  partition.+--+--  Strategy.  Examining just subject and object nodes:+--+--  * all non-blank subject nodes are the root of a top-level partition+--+--  * blank subject nodes that are not the object of exactly one statement+--     are the root of a top-level partition.+--+--  * blank nodes referenced as the object of exactly 1 statement+--     of an existing partition are the root of a sub-partition of the+--     refering partition.+--+--  * what remain are circular chains of blank nodes not referenced+--     elsewhere:  for each such chain, pick a root node arbitrarily.+--+partitionGraph :: (Label lb) => [Arc lb] -> PartitionedGraph lb+partitionGraph arcs =+    makePartitions fixs topv1 intv1+    where+        (fixs,vars)  = partition isNonVar $ collect arcSubj arcs+        vars1        = collectMore arcObj arcs vars+        (intv,topv)  = partition objOnce vars1+        intv1        = map stripObj intv+        topv1        = map stripObj topv+        isNonVar     = not . labelIsVar . fst+        objOnce      = isSingle . snd . snd+        isSingle [_] = True+        isSingle _   = False+        stripObj (k,(s,_)) = (k,s)++-- Local state type for partitioning function+type MakePartitionState lb = ([(lb,[Arc lb])],[(lb,[Arc lb])],[(lb,[Arc lb])])++makePartitions :: (Eq lb) =>+    [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> PartitionedGraph lb+makePartitions fixs topv intv =+    PartitionedGraph $ evalState (makePartitions1 []) (fixs,topv,intv)++-- Use a state monad to keep track of arcs that have been incorporated into+-- the resulting list of graph partitions.  The collections of arcs used to+-- generate the list of partitions are supplied as theinitial state of the+-- monad (see call of evalState above).+--+makePartitions1 :: (Eq lb) =>+    [(lb,[Arc lb])] -> State (MakePartitionState lb) [GraphPartition lb]+makePartitions1 [] =+    do  { s <- pickNextSubject+        ; if null s then return [] else makePartitions1 s+        }+makePartitions1 (sub:subs) =+    do  { ph <- makePartitions2 sub+        ; pt <- makePartitions1 subs+        ; return $ ph++pt+        }++makePartitions2 :: (Eq lb) =>+    (lb,[Arc lb]) -> State (MakePartitionState lb) [GraphPartition lb]+makePartitions2 subs =+    do  { (part,moresubs) <- makeStatements subs+        ; moreparts <- if not (null moresubs) then+            makePartitions1 moresubs+          else+            return []+        ; return $ part:moreparts+        }++makeStatements :: (Eq lb) =>+    (lb,[Arc lb])+    -> State (MakePartitionState lb) (GraphPartition lb,[(lb,[Arc lb])])+makeStatements (sub,stmts) =+    do  { propmore <- mapM makeStatement stmts+        ; let (props,moresubs) = unzip propmore+        ; return (PartSub sub props,concat moresubs)+        }++makeStatement :: (Eq lb) =>+    Arc lb+    -> State (MakePartitionState lb) ((lb,GraphPartition lb),[(lb,[Arc lb])])+makeStatement (Arc _ prop obj) =+    do  { intobj <- pickIntSubject obj+        ; (gpobj,moresubs) <- if null intobj+          then+            do  { ms <- pickVarSubject obj+                ; return (PartObj obj,ms)+                }+          else+            makeStatements (head intobj)+        ; return ((prop,gpobj),moresubs)+        }++pickNextSubject :: State (MakePartitionState lb) [(lb,[Arc lb])]+pickNextSubject =+    do  { (a1,a2,a3) <- get+        ; let (s,st) = case (a1,a2,a3) of+                (s1h:s1t,s2,s3) -> ([s1h],(s1t,s2,s3))+                ([],s2h:s2t,s3) -> ([s2h],([],s2t,s3))+                ([],[],s3h:s3t) -> ([s3h],([],[],s3t))+                ([],[],[])      -> ([]   ,([],[],[] ))+        ; put st+        ; return s+        }++pickIntSubject :: (Eq lb) =>+    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]+pickIntSubject sub =+    do  { (s1,s2,s3) <- get+        ; let varsub = removeBy (\x->(x==).fst) sub s3+        ; if isJust varsub then+            do  { let (vs,s3new) = fromJust varsub+                ; put (s1,s2,s3new)+                ; return [vs]+                }+          else+            return []+        }++pickVarSubject :: (Eq lb) =>+    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]+pickVarSubject sub =+    do  { (s1,s2,s3) <- get+        ; let varsub = removeBy (\x->(x==).fst) sub s2+        ; if isJust varsub then+            do  { let (vs,s2new) = fromJust varsub+                ; put (s1,s2new,s3)+                ; return [vs]+                }+          else+            return []+        }++------------------------------------------------------------+--  Other useful functions+------------------------------------------------------------+--+--  Create a list of pairs of corresponding Partitions that+--  are unequal++comparePartitions :: (Label lb) =>+    PartitionedGraph lb -> PartitionedGraph lb+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+comparePartitions (PartitionedGraph gp1) (PartitionedGraph gp2) =+    comparePartitions1 (reverse gp1) (reverse gp2)++comparePartitions1 :: (Label lb) =>+    [GraphPartition lb] -> [GraphPartition lb]+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+comparePartitions1 pg1 pg2 =+        ds ++ [ (Just r1p,Nothing) | r1p<-r1 ]+           ++ [ (Nothing,Just r2p) | r2p<-r2 ]+    where+        (ds,r1,r2) = listDifferences comparePartitions2 pg1 pg2++--  Compare two graph partitions, with three possible outcomes:+--    Nothing    -> no match+--    Just []    -> total match+--    Just [...] -> partial match, with mismatched sub-partitions listed.+--+--  A partial match occurs when the leading nodes are non-variable and+--  equal, but something else in the partition does not match.+--+--  A complete match can be achieved with variable nodes that have+--  different labels+--+comparePartitions2 :: (Label lb) =>+    GraphPartition lb -> GraphPartition lb+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+comparePartitions2 (PartObj l1) (PartObj l2) =+    if matchNodes l1 l2 then Just [] else Nothing+comparePartitions2 pg1@(PartSub l1 p1s) pg2@(PartSub l2 p2s) =+    if match then comp1 else Nothing+    where+        comp1  = case comparePartitions3 l1 l2 p1s p2s of+                    Nothing -> if matchVar then Nothing+                                           else Just [(Just pg1,Just pg2)]+                    Just [] -> Just []+                    Just ps -> {- if matchVar then Nothing else -} Just ps+        matchVar = labelIsVar l1 && labelIsVar l2+        match    = matchVar || l1 == l2+comparePartitions2 pg1 pg2 =+    if not (labelIsVar l1) && l1 == l2+        then Just [(Just pg1,Just pg2)]+        else Nothing+    where+        l1 = node pg1+        l2 = node pg2++comparePartitions3 :: (Label lb) =>+    lb -> lb -> [(lb,GraphPartition lb)] -> [(lb,GraphPartition lb)]+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+comparePartitions3 l1 l2 s1s s2s = Just $+        ds ++ [ (Just (PartSub l1 [r1p]),Nothing) | r1p<-r1 ]+           ++ [ (Nothing,Just (PartSub l2 [r2p])) | r2p<-r2 ]+    where+        (ds,r1,r2) = listDifferences (comparePartitions4 l1 l2) s1s s2s++comparePartitions4 :: (Label lb) =>+    lb -> lb -> (lb,GraphPartition lb) -> (lb,GraphPartition lb)+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+comparePartitions4 _ _ (p1,o1) (p2,o2) =+    if matchNodes p1 p2 then comp1 else Nothing+    where+        comp1   = case comparePartitions2 o1 o2 of+                    Nothing -> Just [(Just o1,Just o2)]+                    ds      -> ds++matchNodes :: (Label lb) => lb -> lb -> Bool+matchNodes l1 l2+    | labelIsVar l1 = labelIsVar l2+    | otherwise     = l1 == l2+++------------------------------------------------------------+--  Helpers+------------------------------------------------------------++-- |Collect a list of items by some comparison of a selected component+--  or other derived value.+--+--  cmp     a comparison function that determines if a pair of values+--          should be grouped together+--  sel     a function that selects a value from any item+--+--  Example:    collect fst [(1,'a'),(2,'b'),(1,'c')] =+--                  [(1,[(1,'a'),(1,'c')]),(2,[(2,'b')])]+--+collect :: (Eq b) => (a->b) -> [a] -> [(b,[a])]+collect = collectBy (==)++collectBy :: (b->b->Bool) -> (a->b) -> [a] -> [(b,[a])]+collectBy cmp sel = map reverseCollection . collectBy1 cmp sel []++collectBy1 :: (b->b->Bool) -> (a->b) -> [(b,[a])] -> [a] -> [(b,[a])]+collectBy1 _   _   sofar []     = sofar+collectBy1 cmp sel sofar (a:as) =+    collectBy1 cmp sel (collectBy2 cmp sel a sofar) as++collectBy2 :: (b->b->Bool) -> (a->b) -> a -> [(b,[a])] -> [(b,[a])]+collectBy2 _   sel a [] = [(sel a,[a])]+collectBy2 cmp sel a (col@(k,as):cols)+    | cmp ka k  = (k,a:as):cols+    | otherwise = col:collectBy2 cmp sel a cols+    where+        ka = sel a++reverseCollection :: (b,[a]) -> (b,[a])+reverseCollection (k,as) = (k,reverse as)++{-+-- Example/test:+testCollect1 :: [(Int, [(Int, Char)])]+testCollect1 = collect fst [(1,'a'),(2,'b'),(1,'c'),(1,'d'),(2,'d'),(3,'d')]++testCollect2 :: Bool+testCollect2 = testCollect1+                == [ (1,[(1,'a'),(1,'c'),(1,'d')])+                   , (2,[(2,'b'),(2,'d')])+                   , (3,[(3,'d')])+                   ]+-}++-- |Add new values to an existing list of collections.+--  The list of collections is not extended, but each collection is+--  augmented with a further list of values from the supplied list,+--  each of which are related to the existing collection in some way.+--+--  NOTE: the basic pattern of 'collect' and 'collectMore' is similar,+--  and might be generalized into a common set of core functions.+--+collectMore :: (Eq b) => (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]+collectMore = collectMoreBy (==)++collectMoreBy ::+    (b->b->Bool) -> (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]+collectMoreBy cmp sel as cols =+    map reverseMoreCollection $+    collectMoreBy1 cmp sel as (map (\ (b,cs) -> (b,(cs,[])) ) cols)++collectMoreBy1 ::+    (b->b->Bool) -> (a->b) -> [a] -> [(b,(c,[a]))] -> [(b,(c,[a]))]+collectMoreBy1 _   _   []     cols = cols+collectMoreBy1 cmp sel (a:as) cols =+    collectMoreBy1 cmp sel as (collectMoreBy2 cmp sel a cols)++collectMoreBy2 ::+    (b->b->Bool) -> (a->b) -> a -> [(b,(c,[a]))] -> [(b,(c,[a]))]+collectMoreBy2 _   _   _ [] = []+collectMoreBy2 cmp sel a (col@(k,(b,as)):cols)+    | cmp (sel a) k = (k,(b,a:as)):cols+    | otherwise     = col:collectMoreBy2 cmp sel a cols++reverseMoreCollection :: (b,(c,[a])) -> (b,(c,[a]))+reverseMoreCollection (k,(c,as)) = (k,(c,reverse as))++{-+-- Example/test:+testCollectMore1 =+    collectMore snd [(111,1),(112,1),(211,2),(311,3),(411,4)] testCollect1++testCollectMore2 :: Bool+testCollectMore2 = testCollectMore1+                == [ (1,([(1,'a'),(1,'c'),(1,'d')],[(111,1),(112,1)]))+                   , (2,([(2,'b'),(2,'d')],[(211,2)]))+                   , (3,([(3,'d')],[(311,3)]))+                   ]+-}++-- |Remove supplied element from a list using the supplied test+--  function, and return Just the element remoived and the+--  remaining list, or Nothing if no element was matched for removal.+--+{-+remove :: (Eq a) => a -> [a] -> Maybe (a,[a])+remove = removeBy (==)++testRemove1  = remove 3 [1,2,3,4,5]+testRemove2  = testRemove1 == Just (3,[1,2,4,5])+testRemove3  = remove 3 [1,2,4,5]+testRemove4  = testRemove3 == Nothing+testRemove5  = remove 5 [1,2,4,5]+testRemove6  = testRemove5 == Just (5,[1,2,4])+testRemove7  = remove 1 [1,2,4]+testRemove8  = testRemove7 == Just (1,[2,4])+testRemove9  = remove 2 [2]+testRemove10 = testRemove9 == Just (2,[])++-}++removeBy :: (b->a->Bool) -> b -> [a] -> Maybe (a,[a])+removeBy cmp a0 as = removeBy1 cmp a0 as []++removeBy1 :: (b->a->Bool) -> b -> [a] -> [a] -> Maybe (a,[a])+removeBy1 _   _  []     _     = Nothing+removeBy1 cmp a0 (a:as) sofar+    | cmp a0 a  = Just (a,reverseTo sofar as)+    | otherwise = removeBy1 cmp a0 as (a:sofar)++-- |Reverse first argument, prepending the result to the second argument+--+reverseTo :: [a] -> [a] -> [a]+reverseTo front back = foldl (flip (:)) back front++-- |Remove each element from a list, returning a list of pairs,+--  each of which is the element removed and the list remaining.+--+removeEach :: [a] -> [(a,[a])]+removeEach [] = []+removeEach (a:as) = (a,as):[ (a1,a:a1s) | (a1,a1s) <- removeEach as ]++{-+testRemoveEach1 = removeEach [1,2,3,4,5]+testRemoveEach2 = testRemoveEach1 ==+    [ (1,[2,3,4,5])+    , (2,[1,3,4,5])+    , (3,[1,2,4,5])+    , (4,[1,2,3,5])+    , (5,[1,2,3,4])+    ]+-}++-- |List differences between the members of two lists, where corresponding+--  elements may appear at arbitrary locations in the corresponding lists.+--+--  Elements are compared using the function 'cmp', which returns:+--  * Nothing  if the elements are completely unrelated+--  * Just []  if the elements are identical+--  * Just ds  if the elements are related but not identical, in which case+--             ds is a list of values describing differences between them.+--+--  Returns (ds,u1,u2), where:+--  ds is null if the related elements from each list are identical,+--  otherwise is a list of differences between the related elements.+--  u1 is a list of elements in a1 not related to elements in a2.+--  u2 is a list of elements in a2 not related to elements in a1.+--+listDifferences :: (a->a->Maybe [d]) -> [a] -> [a] -> ([d],[a],[a])+listDifferences _   []       a2s = ([],[],a2s)+listDifferences cmp (a1:a1t) a2s =+    case mcomp of+        Nothing       -> morediffs [] [a1] a1t a2s+        Just (ds,a2t) -> morediffs ds []   a1t a2t+    where+        -- mcomp finds identical match, if there is one, or+        -- the first element in a2s related to a1, or Nothing+        -- [choose was listToMaybe,+        --  but that didn't handle repeated properties well]+        mcomp = choose $ mapMaybe maybeResult comps+        comps = [ (cmp a1 a2,a2t) | (a2,a2t) <- removeEach a2s ]+        maybeResult (Nothing,_)   = Nothing+        maybeResult (Just ds,a2t) = Just (ds,a2t)+        morediffs xds xa1h xa1t xa2t  = (xds++xds1,xa1h++xa1r,xa2r)+            where+                (xds1,xa1r,xa2r) = listDifferences cmp xa1t xa2t+        choose  []       = Nothing+        choose  ds@(d:_) = choose1 d ds+        choose1 _ (d@([],_):_)  = Just d+        choose1 d []            = Just d+        choose1 d (_:ds)        = choose1 d ds++{-+testcmp (l1,h1) (l2,h2)+    | (l1 >= h2) || (l2 >= h1) = Nothing+    | (l1 == l2) && (h1 == h2) = Just []+    | otherwise                = Just [((l1,h1),(l2,h2))]++testdiff1 = listDifferences testcmp+                [(12,15),(1,2),(3,4),(5,8),(10,11)]+                [(10,11),(0,1),(3,4),(6,9),(13,15)]+testdiff2 = testdiff1 == ([((12,15),(13,15)),((5,8),(6,9))],[(1,2)],[(0,1)])+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/MapXsdInteger.hs view
@@ -0,0 +1,87 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  MapXsdInteger+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines the datatytpe mapping and relation values+--  used for RDF dataype xsd:integer+--+--------------------------------------------------------------------------------++module Swish.RDF.MapXsdInteger+    ( mapXsdInteger+    )+where++import Swish.RDF.Datatype+    ( DatatypeMap(..)+    )++------------------------------------------------------------+--  Implementation of DatatypeMap for xsd:integer+------------------------------------------------------------++-- |mapXsdInteger contains functions that perform lexical-to-value+--  and value-to-canonical-lexical mappings for xsd:integer values+--+mapXsdInteger :: DatatypeMap Integer+mapXsdInteger = DatatypeMap+    { -- mapL2V :: String -> Maybe Integer+      mapL2V = fromString+      +      -- mapV2L :: Integer -> Maybe String+    , mapV2L = Just . show+    }++-- basic little parser for integer values;+-- do we need to bother about rejecting +-- input like "-000" or "+0"?+--+fromString :: String -> Maybe Integer+fromString ('-':xs) = fs False xs+fromString ('+':xs) = fs True xs+fromString xs       = fs True xs++fs :: Bool -> String -> Maybe Integer+fs _ [] = Nothing+fs f is = +  let val = go is []+      +      go [] ys = Just $ read $ reverse ys+      go (x:xs) ys | x `elem` ['0'..'9'] = go xs (x:ys)+                   | otherwise           = Nothing+        +   in case f of+    True -> val+    False -> fmap ((-1) *) val++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/N3Formatter.hs view
@@ -0,0 +1,998 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  N3Formatter+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module implements a Notation 3 formatter (see [1], [2] and [3]),+--  for an RDFGraph value.+--+--+-- REFERENCES:+--+-- (1) <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>+--     Notation3 (N3): A readable RDF syntax,+--     W3C Team Submission 14 January 2008+--+-- (2) <http://www.w3.org/DesignIssues/Notation3.html>+--     Tim Berners-Lee's design issues series notes and description+--+-- (2) <http://www.w3.org/2000/10/swap/Primer.html>+--     Notation 3 Primer by Sean Palmer+--+--  TODO:+--+--   * Initial prefix list to include nested formulae;+--      then don't need to update prefix list for these.+--+--   * correct output of strings containing unsupported escape+--     characters (such as @\\q@)+--+--   * more flexible terminator generation for formatted formulae+--     (for inline blank nodes.)+--+--------------------------------------------------------------------------------++{-+TODO:++The code used to determine whether a blank node can be written+using the "[]" short form could probably take advantage of the+GraphPartition module.++-}++module Swish.RDF.N3Formatter+    ( NodeGenLookupMap+    , formatGraphAsStringNl+    , formatGraphAsString+    , formatGraphAsShowS+    , formatGraphIndent+    , formatGraphDiag+    )+where++import Swish.RDF.RDFGraph (+  RDFGraph, RDFLabel(..),+  NamespaceMap, RevNamespaceMap,+  emptyNamespaceMap,+  FormulaMap, emptyFormulaMap,+  getArcs, labels,+  setNamespaces, getNamespaces,+  getFormulae,+  emptyRDFGraph,+  res_rdf_first, res_rdf_rest, res_rdf_nil+  )++import Swish.RDF.Vocabulary (+  isLang, langTag, +  rdf_type,+  rdf_nil,+  owl_sameAs, log_implies+  )++import Swish.RDF.GraphClass+    ( Arc(..) )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..)+    , LookupMap, emptyLookupMap, reverseLookupMap+    , listLookupMap+    , mapFind, mapFindMaybe, mapAdd, mapDelete, mapMerge+    )++import Swish.Utils.Namespace+    ( ScopedName(..), getScopeURI )++import Data.Char (ord, isDigit)++import Data.List (foldl', delete, groupBy, intercalate, partition, sort)++import Text.Printf (printf)++import Control.Monad (liftM, when)+import Control.Monad.State (State, get, put, runState)++----------------------------------------------------------------------+--  Ouptut string concatenation+----------------------------------------------------------------------+--+--  Function puts uses the shows mechanism to avoid the cost of+--  quadratic string concatenation times.  (Use function composition to+--  concatenate strings thus reprersented.)++puts :: String -> ShowS+puts = showString++----------------------------------------------------------------------+--  Graph formatting state monad+----------------------------------------------------------------------+--+--  The graph to be formatted is carried as part of the formatting+--  state, so that decisions about what needs to be formatted can+--  themselves be based upon and reflected in the state (e.g. if a+--  decision is made to include a blank node inline, it can be removed+--  from the graph state that remains to be formatted).++type SubjTree lb = [(lb,PredTree lb)]+type PredTree lb = [(lb,[lb])]++data N3FormatterState = N3FS+    { indent    :: String+    , lineBreak :: Bool+    , graph     :: RDFGraph+    , subjs     :: SubjTree RDFLabel+    , props     :: PredTree RDFLabel   -- for last subject selected+    , objs      :: [RDFLabel]          -- for last property selected+    , formAvail :: FormulaMap RDFLabel+    , formQueue :: [(RDFLabel,RDFGraph)]+    , nodeGenSt :: NodeGenState+    , bNodesCheck   :: [RDFLabel]      -- these bNodes are not to be converted to '[..]' format+    , traceBuf  :: [String]+    }++type Formatter a = State N3FormatterState a++emptyN3FS :: NodeGenState -> N3FormatterState+emptyN3FS ngs = N3FS+    { indent    = "\n"+    , lineBreak = False+    , graph     = emptyRDFGraph+    , subjs     = []+    , props     = []+    , objs      = []+    , formAvail = emptyFormulaMap+    , formQueue = []+    , nodeGenSt = ngs+    , bNodesCheck   = []+    , traceBuf  = []+    }++--  | Node name generation state information that carries through+--  and is updated by nested formulae+type NodeGenLookupMap = LookupMap (RDFLabel,Int)++data NodeGenState = Ngs+    { prefixes  :: NamespaceMap+    , nodeMap   :: NodeGenLookupMap+    , nodeGen   :: Int+    }++emptyNgs :: NodeGenState+emptyNgs = Ngs+    { prefixes  = emptyLookupMap+    , nodeMap   = emptyLookupMap+    , nodeGen   = 0+    }++-- simple context for label creation+-- (may be a temporary solution to the problem+--  of label creation)+--+data LabelContext = SubjContext | PredContext | ObjContext+                    deriving (Eq, Show)++getIndent :: Formatter String+getIndent = indent `liftM` get++setIndent :: String -> Formatter ()+setIndent ind = do+  st <- get+  put $ st { indent = ind }++getLineBreak :: Formatter Bool+getLineBreak = lineBreak `liftM` get++setLineBreak :: Bool -> Formatter ()+setLineBreak brk = do+  st <- get+  put $ st {lineBreak = brk}++getNgs :: Formatter NodeGenState+getNgs = nodeGenSt `liftM` get++setNgs :: NodeGenState -> Formatter ()+setNgs ngs = do+  st <- get+  put $ st { nodeGenSt = ngs }++getPrefixes :: Formatter NamespaceMap+getPrefixes = prefixes `liftM` getNgs++getSubjs :: Formatter (SubjTree RDFLabel)+getSubjs = subjs `liftM` get++setSubjs :: SubjTree RDFLabel -> Formatter ()+setSubjs sl = do+  st <- get+  put $ st { subjs = sl }++getProps :: Formatter (PredTree RDFLabel)+getProps = props `liftM` get++setProps :: PredTree RDFLabel -> Formatter ()+setProps ps = do+  st <- get+  put $ st { props = ps }++{-+getObjs :: Formatter ([RDFLabel])+getObjs = objs `liftM` get++setObjs :: [RDFLabel] -> Formatter ()+setObjs os = do+  st <- get+  put $ st { objs = os }+-}++getBnodesCheck :: Formatter ([RDFLabel])+getBnodesCheck = bNodesCheck `liftM` get++{-+addTrace :: String -> Formatter ()+addTrace tr = do+  st <- get+  put $ st { traceBuf = tr : traceBuf st }+-}+  +queueFormula :: RDFLabel -> Formatter ()+queueFormula fn = do+  st <- get+  let fa = formAvail st+      newState fv = st {+                      formAvail = mapDelete fa fn,+                      formQueue = (fn,fv) : formQueue st+                    }+  case mapFindMaybe fn fa of+    Nothing -> return ()+    Just v -> put (newState v) >> return ()++{-+Return the graph associated with the label and delete it+from the store, if there is an association, otherwise+return Nothing.+-}+extractFormula :: RDFLabel -> Formatter (Maybe RDFGraph)+extractFormula fn = do+  st <- get+  let fa = formAvail st+      newState = st { formAvail=mapDelete fa fn }+  case mapFindMaybe fn fa of+    Nothing -> return Nothing+    Just fv -> put newState >> return (Just fv)++{-+moreFormulae :: Formatter Bool+moreFormulae =  do+  st <- get+  return $ not $ null (formQueue st)++nextFormula :: Formatter (RDFLabel,RDFGraph)+nextFormula = do+  st <- get+  let (nf : fq) = formQueue st+  put $ st { formQueue = fq }+  return nf++-}++-- list has a length of 1+len1 :: [a] -> Bool+len1 (_:[]) = True+len1 _ = False++{-|+Given a set of statements and a label, return the details of the+RDF collection referred to by label, or Nothing.++For label to be considered as representing a collection we require the+following conditions to hold (this is only to support the+serialisation using the '(..)' syntax and does not make any statement+about semantics of the statements with regard to RDF Collections):++  - there must be one rdf_first and one rdf_rest statement+  - there must be no other predicates for the label++-} +getCollection ::          +  SubjTree RDFLabel -- ^ statements organized by subject+  -> RDFLabel -- ^ does this label represent a list?+  -> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])+     -- ^ the statements with the elements removed; the+     -- content elements of the collection (the objects of the rdf:first+     -- predicate) and the nodes that represent the spine of the+     -- collection (in reverse order, unlike the actual contents which are in+     -- order).+getCollection subjList lbl = go subjList lbl ([],[]) +    where+      go sl l (cs,ss) | l == res_rdf_nil = Just (sl, reverse cs, ss)+                      | otherwise = do+        (pList1, sl') <- removeItem sl l+        (pFirst, pList2) <- removeItem pList1 res_rdf_first+        (pNext, pList3) <- removeItem pList2 res_rdf_rest++        -- QUS: could I include these checks implicitly in the pattern matches above?+        -- ie instrad of (pFirst, pos1) <- ..+        -- have ([content], pos1) <- ...+        -- ?+        if and [len1 pFirst, len1 pNext, null pList3]+          then go sl' (head pNext) (head pFirst : cs, l : ss)+          else Nothing++{-+TODO:++Should we change the preds/objs entries as well?++-}+extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])+extractList lctxt ln = do+  osubjs <- getSubjs+  oprops <- getProps+  let mlst = getCollection osubjs' ln++      -- we only want to send in rdf:first/rdf:rest here+      fprops = filter ((`elem` [res_rdf_first, res_rdf_rest]) . fst) oprops++      osubjs' =+          case lctxt of+            SubjContext -> (ln, fprops) : osubjs+            _ -> osubjs ++      -- tr = "extractList " ++ show ln ++ " (" ++ show lctxt ++ ")\n -> osubjs= " ++ show osubjs ++ "\n -> opreds= " ++ show oprops ++ "\n -> mlst= " ++ show mlst ++ "\n"+  -- addTrace tr+  case mlst of+    -- sl is guaranteed to be free of (ln,fprops) here if lctxt is SubjContext+    Just (sl,ls,_) -> do+              setSubjs sl+              when (lctxt == SubjContext) $ setProps $ filter ((`notElem` [res_rdf_first, res_rdf_rest]) . fst) oprops+              return (Just ls)++    Nothing -> return Nothing+  +{-+-- for safety I am assuming no ordering of the subject tree+-- but really should be using one of the container types+--    +deleteItems :: (Eq a) => [(a,b)] -> [a] -> [(a,b)]+deleteItems [] _  = []+deleteItems os [] = os+deleteItems os (x:xs) =+  deleteItems (deleteItem os x) xs+    +deleteItem :: (Eq a) => [(a,b)] -> a -> [(a,b)]+deleteItem os x =+  case removeItem os x of+    Just (_, rest) -> rest+    Nothing -> os+-}++{-|+Removes the first occurrence of the item from the+association list, returning it's contents and the rest+of the list, if it exists.+-}+removeItem :: (Eq a) => [(a,b)] -> a -> Maybe (b, [(a,b)])+removeItem os x =+  let (as, bs) = break (\a -> fst a == x) os+  in case bs of+    ((_,b):bbs) -> Just (b, as ++ bbs)+    [] -> Nothing++----------------------------------------------------------------------+--  Define a top-level formatter function:+--  accepts a graph and returns a string+----------------------------------------------------------------------++formatGraphAsStringNl :: RDFGraph -> String+formatGraphAsStringNl gr = formatGraphAsShowS gr "\n"++formatGraphAsString :: RDFGraph -> String+formatGraphAsString gr = formatGraphAsShowS gr ""++formatGraphAsShowS :: RDFGraph -> ShowS+formatGraphAsShowS = formatGraphIndent "\n" True+{- old code:+    where+        (out,_,_,_) = formatGraphDiag gr+-}++formatGraphIndent :: String -> Bool -> RDFGraph -> ShowS+{- working version+formatGraphIndent ind dopref gr = out+    where+        (_,out) = formatGraphDiag1 ind dopref emptyLookupMap gr+-}+formatGraphIndent ind dopref = fst . formatGraphDiag1 ind dopref emptyLookupMap+{-      +formatGraphIndent ind dopref gr = out+    where+        (out',fgs) = formatGraphDiag1 ind dopref emptyLookupMap gr+        tbuff = traceBuf fgs+        -- tr = if null tbuff then "" else "\nDEBUG:\n" ++ concat (reverse tbuff)+        tr = ""+        out = out' . (++ tr)+-}+        +-- | Format graph and return additional information+formatGraphDiag ::+    RDFGraph -> (ShowS,NodeGenLookupMap,Int,[String])+formatGraphDiag gr = (out,nodeMap ngs,nodeGen ngs,traceBuf fgs)+    where+        (out,fgs) = formatGraphDiag1 "\n" True emptyLookupMap gr+        ngs       = nodeGenSt fgs++--  Internal function starts with supplied prefix table and indent string,+--  and returns final state and formatted string.+--  This is provided for diagnostic access to the final state+formatGraphDiag1 :: String -> Bool -> NamespaceMap -> RDFGraph -> (ShowS,N3FormatterState)+formatGraphDiag1 ind dopref pref gr = +    let fg = formatGraph ind " ." False dopref gr+        ngs = emptyNgs {+                prefixes=pref,+                nodeGen=findMaxBnode gr+              }+             +    in runState fg (emptyN3FS ngs)++----------------------------------------------------------------------+--  Formatting as a monad-based computation+----------------------------------------------------------------------++-- ind      is indentation string+-- end      is ending string to be placed after final statement+-- dobreak  is True if a line break is to be inserted at the start+-- dopref   is True if prefix strings are to be generated+--+formatGraph :: String -> String -> Bool -> Bool -> RDFGraph -> Formatter ShowS+formatGraph ind end dobreak dopref gr = do+  setIndent ind+  setLineBreak dobreak+  setGraph gr+  fp <- if dopref+        then formatPrefixes (getNamespaces gr)+        else return $ puts ""+  more <- moreSubjects+  res  <- if more+          then do+            fr <- formatSubjects+            return $ fp . fr . puts end+          else return fp++  return res++formatPrefixes :: NamespaceMap -> Formatter ShowS+formatPrefixes pmap = do+  let mls = map (pref . keyVal) (listLookupMap pmap)+  ls <- sequence mls+  return $ puts $ concat ls+    where+      pref (p,u) = nextLine $ "@prefix "++p++": <"++ quote True u ++"> ."++formatSubjects :: Formatter ShowS+formatSubjects = do+  sb    <- nextSubject+  sbstr <- formatLabel SubjContext sb+  +  flagP <- moreProperties+  if flagP+    then do+      prstr <- formatProperties sb sbstr+      -- fmstr <- formatFormulae ""+      flagS <- moreSubjects+      if flagS+        then do+          fr <- formatSubjects+          return $ puts (prstr ++ " .") . fr+          -- return $ puts (prstr ++ fmstr ++ " .") . fr+        else return $ puts $ prstr+        -- else return $ puts $ prstr ++ fmstr+           +    else do+         txt <- nextLine sbstr+         return $ puts txt+    +formatProperties :: RDFLabel -> String -> Formatter String+formatProperties sb sbstr = do+  pr <- nextProperty sb+  prstr <- formatLabel PredContext pr+  obstr <- formatObjects sb pr (sbstr++" "++prstr)+  more  <- moreProperties+  let sbindent = replicate (length sbstr) ' '+  if more+    then do+      fr <- formatProperties sb sbindent+      nl <- nextLine $ obstr ++ " ;"+      return $ nl ++ fr+    else nextLine obstr++formatObjects :: RDFLabel -> RDFLabel -> String -> Formatter String+formatObjects sb pr prstr = do+  ob    <- nextObject sb pr+  obstr <- formatLabel ObjContext ob+  more  <- moreObjects+  if more+    then do+      let prindent = replicate (length prstr) ' '+      fr <- formatObjects sb pr prindent+      nl <- nextLine $ prstr ++ " " ++ obstr ++ ","+      return $ nl ++ fr+    else return $ prstr ++ " " ++ obstr++{-+formatFormulae :: String -> Formatter String+formatFormulae fp = do+  more  <- moreFormulae+  if more+    then do+      fnlgr <- nextFormula+      fnstr <- formatFormula fnlgr+      formatFormulae $ fp ++ " ." ++ fnstr+    else return fp++TODO: need to remove the use of :-. It's not clear to me whether+we are guaranteed that fn is only used once in the graph - ie+if it is safe to inline this formula at the label location.++formatFormula :: (RDFLabel,RDFGraph) -> Formatter String+formatFormula (fn,gr) = do+  fnstr <- formatLabel SubjContext fn+  f1str <- nextLine $ fnstr ++ " :-"+  f2str <- nextLine "    {"+  ngs0  <- getNgs+  ind   <- getIndent+  let grm = formatGraph (ind++"    ") "" True False+            (setNamespaces emptyNamespaceMap gr)+            +      (f3str, fgs') = runState grm (emptyN3FS ngs0)++  setNgs (nodeGenSt fgs')+  f4str <- nextLine "    }"+  return $ f1str ++ f2str ++ f3str f4str++-}++--- DJB's version of formatFormula when it can be inserted inline+insertFormula :: RDFGraph -> Formatter String+insertFormula gr = do+  ngs0  <- getNgs+  ind   <- getIndent+  let grm = formatGraph (ind++"    ") "" True False+            (setNamespaces emptyNamespaceMap gr)++      (f3str, fgs') = runState grm (emptyN3FS ngs0)++  setNgs (nodeGenSt fgs')+  f4str <- nextLine " } "+  return $ " { " ++ f3str f4str++{-+Add a list inline. We are given the labels that constitute+the list, in order, so just need to display them surrounded+by ().+-}+insertList :: [RDFLabel] -> Formatter String+insertList [] = return $ "()" -- not convinced this can happen+insertList xs = do+  ls <- mapM (formatLabel ObjContext) xs+  return $ "( " ++ intercalate " " ls ++ " )"+  +  +{-+Add a blank node inline.+-}++insertBnode :: LabelContext -> RDFLabel -> Formatter String  +insertBnode SubjContext lbl = do+  flag <- moreProperties+  txt <- if flag+         then liftM (++"\n") $ formatProperties lbl ""+         else return ""++  -- TODO: handle indentation?+  return $ "[" ++ txt ++ "]"++insertBnode _ lbl = do+  ost <- get+  let osubjs = subjs ost+      oprops = props ost+      oobjs  = objs  ost++      (bsubj, rsubjs) = partition ((== lbl) . fst) osubjs++      rprops = case bsubj of+                 [(_,rs)] -> rs+                 _ -> []++      -- we essentially want to create a new subgraph+      -- for this node but it's not as simple as that since+      -- we could have something like+      --     :a :b [ :foo [ :bar "xx" ] ]+      -- so we still need to carry around the whole graph+      --+      nst = ost { subjs = rsubjs,+                  props = rprops,+                  objs  = []+                }++  put nst+  flag <- moreProperties+  txt <- if flag+         then liftM (++"\n") $ formatProperties lbl ""+         else return ""++  -- TODO: how do we restore the original set up?+  --       I can't believe the following is sufficient+  --+  nst' <- get+  let slist  = map fst $ subjs nst'+      nsubjs = filter (\(l,_) -> l `elem` slist) osubjs++  put $ nst' { subjs = nsubjs,+                       props = oprops, +                       objs  = oobjs+             }++  -- TODO: handle indentation?+  return $ "[" ++ txt ++ "]"+  +----------------------------------------------------------------------+--  Formatting helpers+----------------------------------------------------------------------++setGraph        :: RDFGraph -> Formatter ()+setGraph gr = do+  st <- get++  let ngs0 = nodeGenSt st+      pre' = mapMerge (prefixes ngs0) (getNamespaces gr)+      ngs' = ngs0 { prefixes = pre' }+      arcs = sortArcs $ getArcs gr+      nst  = st  { graph     = gr+                 , subjs     = arcTree arcs+                 , props     = []+                 , objs      = []+                 , formAvail = getFormulae gr+                 , nodeGenSt = ngs'+                 , bNodesCheck   = countBnodes arcs+                 }++  put nst++moreSubjects    :: Formatter Bool+moreSubjects    = (not . null . subjs) `liftM` get++nextSubject     :: Formatter RDFLabel+nextSubject     = do+  st <- get++  let sb:sbs = subjs st+      nst = st  { subjs = sbs+                , props = snd sb+                , objs  = []+                }++  put nst+  return $ fst sb++moreProperties  :: Formatter Bool+moreProperties  = (not . null . props) `liftM` get++nextProperty    :: RDFLabel -> Formatter RDFLabel+nextProperty _ = do+  st <- get++  let pr:prs = props st+      nst = st  { props = prs+                 , objs  = snd pr+                 }++  put nst+  return $ fst pr+++moreObjects     :: Formatter Bool+moreObjects     = (not . null . objs) `liftM` get++nextObject      :: RDFLabel -> RDFLabel -> Formatter RDFLabel+nextObject _ _ = do+  st <- get++  let ob:obs = objs st+      nst = st { objs = obs }++  put nst+  return ob++nextLine        :: String -> Formatter String+nextLine str = do+  ind <- getIndent+  brk <- getLineBreak+  if brk+    then return $ ind++str+    else do+      --  After first line, always insert line break+      setLineBreak True+      return str++--  Format a label+--  Most labels are simply displayed as provided, but there are a+--  number of wrinkles to take care of here:+--  (a) blank nodes automatically allocated on input, with node+--      identifiers of the form of a digit string nnn.  These are+--      not syntactically valid, and are reassigned node identifiers+--      of the form _nnn, where nnn is chosen so that is does not+--      clash with any other identifier in the graph.+--  (b) URI nodes:  if possible, replace URI with qname,+--      else display as <uri>+--  (c) formula nodes (containing graphs).+--+--  [[[TODO:]]]+--  (d) generate multi-line literals when appropriate+--+-- This is being updated to produce inline formula, lists and     +-- blank nodes. The code is not efficient.+--++specialTable :: [(ScopedName, String)]+specialTable = +  [ (rdf_type, "a")+  , (owl_sameAs, "=")+  , (log_implies, "=>")+  , (rdf_nil, "()")+  ]+  +formatLabel :: LabelContext -> RDFLabel -> Formatter String+{-+formatLabel lab@(Blank (_:_)) = do+  name <- formatNodeId lab+  queueFormula lab+  return name+-}++{-+The "[..]" conversion is done last, after "()" and "{}" checks.+-}+formatLabel lctxt lab@(Blank (_:_)) = do+  mlst <- extractList lctxt lab+  case mlst of+    Just lst -> insertList lst+    Nothing -> do+              mfml <- extractFormula lab+              case mfml of+                Just fml -> insertFormula fml+                Nothing -> do+                          nb1 <- getBnodesCheck+                          if lctxt /= PredContext && lab `notElem` nb1+                            then insertBnode lctxt lab+                            else formatNodeId lab++formatLabel _ lab@(Res sn) = +  case lookup sn specialTable of+    Just txt -> return $ quote True txt -- TODO: do we need to quote?+    Nothing -> do+      pr <- getPrefixes+      let nsuri  = getScopeURI sn+          local  = snLocal sn+          premap = reverseLookupMap pr :: RevNamespaceMap+          prefix = mapFindMaybe nsuri premap+          name   = case prefix of+                     Just p -> quote True (p ++ ":" ++ local) -- TODO: what are quoting rules for QNames+                     _ -> "<"++ quote True (nsuri++local) ++">"+      queueFormula lab+      return name++formatLabel _ (Lit lit mlit) = return $ quoteStr lit ++ formatAnnotation mlit++formatLabel _ lab = return $ show lab++-- the annotation for a literal (ie type or language)+formatAnnotation :: Maybe ScopedName -> String+formatAnnotation Nothing = ""+formatAnnotation (Just a)  | isLang a  = '@' : langTag a+                           | otherwise = '^':'^': showScopedName a++{-+Swish.Utils.MiscHelpers contains a quote routine+which we expand upon here to match the N3 syntax.++We have to decide whether to use " or """ to quote+the string.++There is also no need to restrict the string to the+ASCII character set; this could be an option but we+can also leave Unicode as is (or at least convert to UTF-8).+-}++quoteStr :: String -> String+quoteStr st = +  let qst = quote (n==1) st+      n = if '\n' `elem` st || '"' `elem` st then 3 else 1+      qch = replicate n '"'                              +  in qch ++ qst ++ qch++-- if the first element is True then we need to +-- quote " and new lines.+--+quote :: Bool -> String -> String+quote _     []           = ""+quote True  ('"': st)    = '\\':'"': quote True  st+quote True  ('\n':st)    = '\\':'n': quote True  st+quote True  ('\t':st)    = '\\':'t': quote True  st+quote False ('"': st)    =      '"': quote False st+quote False ('\n':st)    =     '\n': quote False st+quote False ('\t':st)    =     '\t': quote False st+quote f ('\r':st)    = '\\':'r': quote f st+quote f ('\\':st)    = '\\':'\\': quote f st -- not sure about this+quote f (c:st) = +  let nc = ord c+      rst = quote f st+      +      -- lazy way to convert to a string+      hstr = printf "%08X" nc+      ustr = hstr ++ rst++  in if nc > 0xffff +     then '\\':'U': ustr+     else if nc > 0x7e || nc < 0x20+          then '\\':'u': drop 4 ustr+          else c : rst+                      +formatNodeId :: RDFLabel -> Formatter String+formatNodeId lab@(Blank (lnc:_)) =+    if isDigit lnc then mapBlankNode lab else return $ show lab+formatNodeId other = error $ "formatNodeId not expecting a " ++ show other -- to shut up -Wall++mapBlankNode :: RDFLabel -> Formatter String+mapBlankNode lab = do+  ngs <- getNgs+  let cmap = nodeMap ngs+      cval = nodeGen ngs+  nv <- case mapFind 0 lab cmap of+    0 -> do +      let nval = succ cval+          nmap = mapAdd cmap (lab, nval)+      setNgs $ ngs { nodeGen = nval, nodeMap = nmap }+      return nval+      +    n -> return n+  +  -- TODO: is this what we want?+  return $ "_:swish" ++ show nv++-- TODO: need to be a bit more clever with this than we did in NTriples+--       not sure the following counts as clever enough ...+--  +showScopedName :: ScopedName -> String+{-+showScopedName (ScopedName n l) = +  let uri = nsURI n ++ l+  in quote uri+-}+showScopedName = quote True . show++----------------------------------------------------------------------+--  Graph-related helper functions+----------------------------------------------------------------------++newtype SortedArcs lb = SA [Arc lb]++sortArcs :: (Ord lb) => [Arc lb] -> SortedArcs lb+sortArcs = SA . sort++--  Rearrange a list of arcs into a tree of pairs which group together+--  all statements for a single subject, and similarly for multiple+--  objects of a common predicate.+--+arcTree :: (Eq lb) => SortedArcs lb -> SubjTree lb+arcTree (SA as) = commonFstEq (commonFstEq id) $ map spopair as+    where+        spopair (Arc s p o) = (s,(p,o))++{-+arcTree as = map spopair $ sort as+    where+        spopair (Arc s p o) = (s,[(p,[o])])+-}++--  Rearrange a list of pairs so that multiple occurrences of the first+--  are commoned up, and the supplied function is applied to each sublist+--  with common first elements to obtain the corresponding second value+commonFstEq :: (Eq a) => ( [b] -> c ) -> [(a,b)] -> [(a,c)]+commonFstEq f ps =+    [ (fst $ head sps,f $ map snd sps) | sps <- groupBy fstEq ps ]+    where+        fstEq (f1,_) (f2,_) = f1 == f2++{-+-- Diagnostic code for checking arcTree logic:+testArcTree = (arcTree testArcTree1) == testArcTree2+testArcTree1 =+    [Arc "s1" "p11" "o111", Arc "s1" "p11" "o112"+    ,Arc "s1" "p12" "o121", Arc "s1" "p12" "o122"+    ,Arc "s2" "p21" "o211", Arc "s2" "p21" "o212"+    ,Arc "s2" "p22" "o221", Arc "s2" "p22" "o222"+    ]+testArcTree2 =+    [("s1",[("p11",["o111","o112"]),("p12",["o121","o122"])])+    ,("s2",[("p21",["o211","o212"]),("p22",["o221","o222"])])+    ]+-}+++findMaxBnode :: RDFGraph -> Int+findMaxBnode = maximum . map getAutoBnodeIndex . labels++getAutoBnodeIndex   :: RDFLabel -> Int+getAutoBnodeIndex (Blank ('_':lns)) = res where+    -- cf. prelude definition of read s ...+    res = case [x | (x,t) <- reads lns, ("","") <- lex t] of+            [x] -> x+            _   -> 0+getAutoBnodeIndex _                   = 0++{-+Find all blank nodes that occur+  - any number of times as a subject+  - 0 or 1 times as an object++Such nodes can be output using the "[..]" syntax. To make it simpler+to check we actually store those nodes that can not be expanded.++Note that we do not try and expand any bNode that is used in+a predicate position.++Should probably be using the SubjTree RDFLabel structure but this+is easier for now.++-}++countBnodes :: SortedArcs RDFLabel -> [RDFLabel]+countBnodes (SA as) = snd (foldl' ctr ([],[]) as)+    where+      -- first element of tuple are those blank nodes only seen once,+      -- second element those blank nodes seen multiple times+      --+      inc b@(b1s,bms) l@(Blank _) | l `elem` bms = b+                                  | l `elem` b1s = (delete l b1s, l:bms)+                                  | otherwise    = (l:b1s, bms)+      inc b _ = b++      -- if the bNode appears as a predicate we instantly add it to the+      -- list of nodes not to expand, even if only used once+      incP b@(b1s,bms) l@(Blank _) | l `elem` bms = b+                                   | l `elem` b1s = (delete l b1s, l:bms)+           			   | otherwise    = (b1s, l:bms)+      incP b _ = b++      ctr orig (Arc _ p o) = inc (incP orig p) o++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/N3Parser.hs view
@@ -0,0 +1,1651 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  N3Parser+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module implements a Notation 3 parser (see [1], [2], [3]), returning a+--  new 'RDFGraph' consisting of triples and namespace information parsed from+--  the supplied N3 input string, or an error indication.+--+--  Uses the Parsec monadic parser library.+--+-- REFERENCES:+--+-- 1 <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>+--     Notation3 (N3): A readable RDF syntax,+--     W3C Team Submission 14 January 2008+--+-- 2 <http://www.w3.org/DesignIssues/Notation3.html>+--     Tim Berners-Lee's design issues series notes and description+--+-- 3 <http://www.w3.org/2000/10/swap/Primer.html>+--     Notation 3 Primer by Sean Palmer+--+-- NOTES:+--+--  UTF-8 handling is not really tested.+--+--  Several items seem to be allowed (from looking at N3 test suites and files+--  'in the wild') that are not given supported by the N3 grammar [1]. We try+--  to support these, including+--+--    - \"@:@\" and \"@base:@\" as valid QNames (ie a blank local component)+--+--    - @true@ and @false@ as well as @\@true@ and @\@false@+--+--    - use of lower-case characters for @\\u@ and @\\U@ escape codes+--+--  No performance testing has been applied.+--+--  Not all N3 grammar elements are supported, including:+--+--    - @\@forSome@ (we read it in but ignore the arguments)+--+--    - @\@forAll@  (this causes a parse error)+--+--    - formulae are lightly tested+--+--    - string support is incomplete (e.g. unrecognized escape characters+--      such as @\\q@ are probably handled incorrectly)+--+--------------------------------------------------------------------------------++module Swish.RDF.N3Parser+    ( ParseResult+    , parseN3      +    , parseN3fromString+    , parseAnyfromString+    , parseTextFromString, parseAltFromString+    , parseNameFromString, parsePrefixFromString+    , parseAbsURIrefFromString, parseLexURIrefFromString, parseURIref2FromString+    +    -- * Exports for parsers that embed Notation3 in a bigger syntax+    , N3Parser, N3State(..), SpecialMap+    , whiteSpace, symbol, lexeme, eof, identStart, identLetter+    --                                                +    , getPrefix -- a combination of the old defaultPrefix and namedPrefix productions+    , n3symbol -- replacement for uriRef2 -- TODO: check this is semantically correct      +    , quickVariable -- was varid      +    , lexUriRef       +    , document, subgraph                                                   +    , newBlankNode+    )+where++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , NamespaceMap+    , LookupFormula(..) +    , addArc +    , setFormula+    , setNamespaces+    , emptyRDFGraph+    )++import Swish.RDF.GraphClass+    ( arc )++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , mapFind, mapFindMaybe, mapReplaceOrAdd )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    , getScopePrefix +    , getScopedNameURI+    , makeScopedName, makeUriScopedName+    , makeQNameScopedName+    , nullScopedName+    )++import Swish.Utils.QName (QName, getQNameURI)++import Swish.RDF.Vocabulary+    ( langName+    , rdf_type+    , rdf_first, rdf_rest, rdf_nil+    , owl_sameAs, log_implies+    , xsd_boolean, xsd_integer, xsd_decimal, xsd_double+    )++import Swish.RDF.RDFParser+    ( SpecialMap+    , mapPrefix+    , prefixTable, specialTable+    , ParseResult, RDFParser+    , n3Style, n3Lexer, ignore+    , annotateParsecError+    , mkTypedLit+    )++import Control.Applicative+import Control.Monad (forM_, foldM)++import Network.URI (URI, +                    relativeTo,+                    parseURI, parseURIReference, uriToString)++import Data.Maybe (fromMaybe, fromJust)++import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))+import qualified Text.ParserCombinators.Parsec as PC+import qualified Text.ParserCombinators.Parsec.Token as P++import Data.Char (isSpace, chr) +++----------------------------------------------------------------------+--  Set up token parsers+----------------------------------------------------------------------++lexer :: P.TokenParser N3State+lexer = n3Lexer++whiteSpace :: N3Parser ()+whiteSpace = P.whiteSpace lexer++symbol :: String -> N3Parser String+symbol     = P.symbol     lexer++lexeme :: N3Parser a -> N3Parser a+lexeme     = P.lexeme     lexer++identStart , identLetter :: CharParser st Char+identStart  = P.identStart  n3Style+identLetter = P.identLetter n3Style++----------------------------------------------------------------------+-- Define parser state and helper functions+----------------------------------------------------------------------++-- | N3 parser state+data N3State = N3State+        { graphState :: RDFGraph            -- Graph under construction+        , thisNode   :: RDFLabel            -- current context node (aka 'this')+        , prefixUris :: NamespaceMap        -- namespace prefix mapping table+        , syntaxUris :: SpecialMap          -- special name mapping table+        , nodeGen    :: Int                 -- blank node id generator+        , keywordsList :: [String]          -- contents of the @keywords statement+        , allowLocalNames :: Bool           -- True if @keywords used so that bare names are QNames in default namespace+        }++-- | Functions to update N3State vector (use with Parsec updateState)+setPrefix :: String -> String -> N3State -> N3State+setPrefix pre uri st =  st { prefixUris=p' }+    where+        p'    = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)++-- | Set name for special syntax element+setSName :: String -> ScopedName -> N3State -> N3State+setSName nam snam st =  st { syntaxUris=s' }+    where+        s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)+setSUri :: String -> String -> N3State -> N3State+setSUri nam suri = setSName nam (makeScopedName "" suri "")++-- | Set the list of tokens that can be used without needing the leading +-- \@ symbol.+setKeywordsList :: [String] -> N3State -> N3State+setKeywordsList ks st = st { keywordsList = ks, allowLocalNames = True }++--  Functions to access state:++-- | Get name for special syntax element, default null+getSName :: N3State -> String -> ScopedName+getSName st nam =  mapFind nullScopedName nam (syntaxUris st)++getSUri :: N3State -> String -> String+getSUri st nam = getScopedNameURI $ getSName st nam++--  Map prefix to namespace+getPrefixNs :: N3State -> String -> Namespace+getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre)++--  Map ScopedName using prefix table+--  (Ignore URI in supplied ScopedName)+getPrefixScopedName :: N3State -> ScopedName -> ScopedName+getPrefixScopedName st snam = ScopedName (getPrefixNs st pre) loc+    where+        pre = getScopePrefix snam+        loc = snLocal snam++getKeywordsList :: N3State -> [String]+getKeywordsList = keywordsList++getAllowLocalNames :: N3State -> Bool+getAllowLocalNames = allowLocalNames++--  Return function to update graph in N3 parser state,+--  using the supplied function of a graph+--  (use returned function with Parsec updateState)+updateGraph :: ( RDFGraph -> RDFGraph ) -> ( N3State -> N3State )+updateGraph f s = s { graphState = f (graphState s) }++----------------------------------------------------------------------+--  Define top-level parser function:+--  accepts a string and returns a graph or error+----------------------------------------------------------------------++type N3Parser a = RDFParser N3State a++-- | Parse a string as N3 (with no real base URI).+-- +-- See 'parseN3' if you need to provide a base URI.+--+parseN3fromString ::+  String -- ^ input in N3 format.+  -> ParseResult+parseN3fromString = parseAnyfromString document Nothing ++-- | Parse a string with an optional base URI.+--            +-- See also 'parseN3fromString'.            +--+parseN3 ::+  String -- ^ input in N3 format.+  -> Maybe QName -- ^ optional base URI+  -> ParseResult+parseN3 = flip (parseAnyfromString document)++{-+-- useful for testing+test :: String -> RDFGraph+test = either error id . parseAnyfromString document Nothing+-}++-- | Function to supply initial context and parse supplied term.+--+-- We augment the Parsec error with the context.+--+parseAnyfromString :: N3Parser a      -- ^ parser to apply+                      -> Maybe QName  -- ^ base URI of the input, or @Nothing@ to use default base value+                      -> String       -- ^ input to be parsed+                      -> Either String a+parseAnyfromString parser mbase input =+  let pmap   = LookupMap prefixTable+      muri   = fmap makeQNameScopedName mbase+      smap   = LookupMap $ specialTable muri+      pstate = N3State+              { graphState = emptyRDFGraph+              , thisNode   = NoNode+              , prefixUris = pmap+              , syntaxUris = smap+              , nodeGen    = 0+              , keywordsList = ["a", "is", "of", "true", "false"] -- not 100% sure about true/false here+              , allowLocalNames = False+              }+  +      puri = case mbase of+        Just base -> fmap showURI $ appendUris (getQNameURI base) "#"+        _ -> Right "#"++      -- this is getting a bit ugly+        +  in case puri of+    Left emsg -> Left $ "Invalid base: " ++ emsg+    Right p -> case runParser parser (setPrefix "" p pstate) "" input of+      Right res -> Right res+      Left  err -> Left $ annotateParsecError 1 (lines input) err++newBlankNode :: N3Parser RDFLabel+newBlankNode = do+  s <- getState+  let n = succ (nodeGen s)+  setState $ s { nodeGen = n } +  return $ Blank (show n)+  +--  Test functions for selected element parsing++parseTextFromString :: String -> String -> Either String String+parseTextFromString s =+    parseAnyfromString (string s) Nothing++parseAltFromString :: String -> String -> String -> Either String String+parseAltFromString s1 s2 =+    parseAnyfromString ( string s1 <|> string s2 ) Nothing++parseNameFromString :: String -> Either String String+parseNameFromString =+    parseAnyfromString n3Name Nothing++parsePrefixFromString :: String -> Either String Namespace+parsePrefixFromString =+    parseAnyfromString p Nothing+      where+        p = do+          pref <- n3Name+          st   <- getState+          return (getPrefixNs st pref)   -- map prefix to namespace++parseAbsURIrefFromString :: String -> Either String String+parseAbsURIrefFromString =+    parseAnyfromString (fmap showURI explicitURI) Nothing+    -- parseAnyfromString absUriRef Nothing++parseLexURIrefFromString :: String -> Either String String+parseLexURIrefFromString =+    parseAnyfromString lexUriRef Nothing++parseURIref2FromString :: String -> Either String ScopedName+parseURIref2FromString =+    parseAnyfromString n3symbol Nothing+    -- parseAnyfromString uriRef2 Nothing++----------------------------------------------------------------------+--  Syntax productions+----------------------------------------------------------------------++{-+ TODO:+    - this parser is a *lot* slower than the original one+  +-}++-- helper routines++comma, semiColon , fullStop :: N3Parser ()+comma = ignore $ symbol ","+semiColon = ignore $ symbol ";"+fullStop = ignore $ symbol "."++-- a specialization of bracket/between +br :: String -> String -> N3Parser a -> N3Parser a+br lsym rsym = between (symbol lsym) (symbol rsym)++-- The @ character is optional if the keyword is in the+-- keyword list+--+atSign :: String -> N3Parser ()+atSign s = do+  st <- getState+  +  let p = ignore $ char '@'+  +  if s `elem` getKeywordsList st+    then PC.optional p+    else p+         +atWord :: String -> N3Parser String+atWord s = do+  atSign s+  +  -- TODO: does it really make sense to add the not-followed-by-a-colon rule here?+  -- apply to both cases even though should only really be necessary+  -- when the at sign is not given+  --+  lexeme $ string s *> notFollowedBy (char ':')+  return s++showURI :: URI -> String+showURI u = uriToString id u ""++-- TODO: look at using URIs throughout+getScopedNameURI' :: URI -> String+getScopedNameURI' = showURI+-- getScopedNameURI' = getScopedNameURI . makeUriScopedName . showURI++operatorLabel :: ScopedName -> N3Parser RDFLabel+{-+operatorLabel snam = do+  s <- getState+  return $ Res $ getPrefixScopedName s snam+-}+operatorLabel snam = (Res . flip getPrefixScopedName snam) <$> getState++-- Add statement to graph in N3 parser state++addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> N3Parser ()+addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))++addStatementRev :: RDFLabel -> RDFLabel -> RDFLabel -> N3Parser ()+addStatementRev o p s = addStatement s p o++{-+A number of productions require a name, which starts with++[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]++and then has++[\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*++we encode this as the n3Name production+-}++initChar , bodyChar :: String+initChar =+  ['A'..'Z'] ++ "_" ++ ['a'..'z'] +++  map chr +  ([0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x02ff] ++ [0x0370..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])+bodyChar = +  '-' : ['0'..'9'] ++ ['A'..'Z'] ++ "_" ++ ['a'..'z'] +++  map chr+  (0x00b7 : [0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x203f..0x2040] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])++n3Name :: N3Parser String+n3Name = (:) <$> n3Init <*> n3Body+  where+    n3Init = oneOf initChar <?> "Initial character of a name"+    n3Body = many (oneOf bodyChar) <?> "Body of the name"++{-+quickvariable ::=	\?[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*+-}++-- TODO: is mapping to Var correct?+quickVariable :: N3Parser RDFLabel+quickVariable = char '?' *> (Var <$> n3Name) <?> "quickvariable"++{-+string ::=	("""[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*""")|("[^"\\]*(?:\\.[^"\\]*)*")++or++string ::= tripleQuoted | singleQUoted++-}++n3string :: N3Parser String+n3string = tripleQuoted <|> singleQuoted <?> "string"++{-+singleQuoted ::=  "[^"\\]*(?:\\.[^"\\]*)*"++asciiChars :: String+asciiChars = map chr [0x20..0x7e]++asciiCharsN3 :: String+asciiCharsN3 = filter (`notElem` "\\\"") asciiChars++-}++-- the grammer has only upper-case A-F but some lower case values+-- seen in the wild, so support them+--+ntHexDigit :: N3Parser Char+ntHexDigit = oneOf $ ['0'..'9'] ++ ['A'..'F'] ++ ['a'..'f']++hex4 :: N3Parser Char+hex4 = do+  digs <- count 4 ntHexDigit+  let dstr = "0x" ++ digs+      dchar = read dstr :: Int+  return $ chr dchar+        +hex8 :: N3Parser Char+hex8 = do+  digs <- count 8 ntHexDigit+  let dstr = "0x" ++ digs+      dchar = read dstr :: Int+  if dchar <= 0x10FFFF+    then return $ chr dchar+    else unexpected "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"++{-+This is very similar to NTriples accept that also allow the escaping of '+even though it is not required.++The Python rules allow \N{name}, where name is the Unicode name. It's+not clear whether we need to support this too, so for now we do not.++-}+protectedChar :: N3Parser Char+protectedChar =+  (char 't' *> return '\t')+  <|> (char 'n' *> return '\n')+  <|> (char 'r' *> return '\r')+  <|> (char '"' *> return '"')+  <|> (char '\'' *> return '\'')+  <|> (char '\\' *> return '\\')+  <|> (char 'u' *> hex4)+  <|> (char 'U' *> hex8)++-- Accept an escape character or any character as long as it isn't+-- a new-line or quote. Unrecognized escape sequences should therefore+-- be left alone by this. +--+n3Character :: N3Parser Char+n3Character = +  (char '\\' *> (protectedChar <|> return '\\'))+  <|> noneOf "\"\n"+      +{-+      <|> (oneOf asciiCharsN3 <?> "ASCII character")+              -- TODO: bodyChar and asciiCharsN3 overlap+      <|> (oneOf bodyChar <?> "Unicode character")+-}              ++sQuot :: N3Parser Char+sQuot = char '"'++singleQuoted :: N3Parser String+singleQuoted = between sQuot sQuot $ many n3Character+    +{-+tripleQUoted ::=	"""[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*"""+-}+tripleQuoted :: N3Parser String+tripleQuoted = tQuot *> manyTill (n3Character <|> sQuot <|> char '\n') tQuot+  where+    tQuot = try (count 3 sQuot)++getDefaultPrefix :: N3Parser Namespace+getDefaultPrefix = do+  s <- getState+  return (getPrefixNs s "")++addBase :: URI -> N3Parser ()+addBase = updateState . setSUri "base" . getScopedNameURI'++addPrefix :: Maybe String -> URI -> N3Parser ()+addPrefix p = updateState . setPrefix (fromMaybe "" p) . getScopedNameURI'++{-|+Update the set of keywords that can be given without+an \@ sign.+-}+updateKeywordsList :: [String] -> N3Parser ()+updateKeywordsList = updateState . setKeywordsList++{-+document ::=		|	statements_optional EOF+-}++document :: N3Parser RDFGraph+document = mkGr <$> (whiteSpace *> statementsOptional *> eof *> getState)+  where+    mkGr s = setNamespaces (prefixUris s) (graphState s)++{-+statements_optional ::=		|	statement  "."  statements_optional+		|	void++-}++statementsOptional :: N3Parser ()+statementsOptional = ignore $ endBy (lexeme statement) fullStop+    +{-+statement ::=		|	declaration+		|	existential+		|	simpleStatement+		|	universal++-}++statement :: N3Parser ()+statement =+  declaration+  <|> existential+  <|> universal+  <|> simpleStatement+  -- having an error here leads to less informative errors in general, it seems+  -- <?> "statement (existential or universal quantification or a simple statement)"+  +{-+declaration ::=		|	 "@base"  explicituri+		|	 "@keywords"  barename_csl+		|	 "@prefix"  prefix explicituri+-}++-- TODO: do we need the try statements here? atWord would need to have a try on '@'+-- (if applicable) which should mean being able to get rid of try+--+declaration :: N3Parser ()+declaration = +  (try (atWord "base") >> explicitURI >>= addBase)+  <|>+  (try (atWord "keywords") >> bareNameCsl >>= updateKeywordsList)+  <|>+  (try (atWord "prefix") *> getPrefix)+  <?> "declaration"+  +getPrefix :: N3Parser ()  +getPrefix = do+  p <- lexeme prefix+  u <- explicitURI+  addPrefix p u++{-+explicituri ::=	<[^>]*>++Note: white space is to be ignored within <>+-}++explicitURI :: N3Parser URI+explicitURI = do+  let lb = char '<'+      rb = char '>'+  +  -- TODO: do the whitespace definitions match?+  ustr <- between lb (rb <?> "end of URI '>'") $ many (satisfy (/= '>'))+  let uclean = filter (not . isSpace) ustr+      +  s <- getState+  let base = getSUri s "base"+      +  case appendUris base uclean of +    Right uri -> return uri+    Left emsg -> fail emsg+      +appendUris :: String -> String -> Either String URI+appendUris base uri =+  case parseURI uri of+    Just absuri -> Right absuri+    _ -> case parseURIReference uri of+      Just reluri -> +        let baseuri = fromJust $ parseURI base+        in case relativeTo reluri baseuri of+          Just resuri -> Right resuri+          _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ base ++ ">"+          +      _ -> Left $ "Invalid URI: <" ++ uri ++ ">"+      +-- production from the old parser+lexUriRef :: N3Parser String+lexUriRef = fmap showURI $ lexeme explicitURI++{-+barename ::=	[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*+barename_csl ::=		|	barename barename_csl_tail+		|	void+barename_csl_tail ::=		|	 ","  barename barename_csl_tail+		|	void+-}++bareNameCsl :: N3Parser [String]+bareNameCsl = sepBy (lexeme bareName) comma++bareName :: N3Parser String+bareName = n3Name <?> "barename"++{-+prefix ::=	([A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*)?:+-}++prefix :: N3Parser (Maybe String)+prefix = optional (lexeme n3Name) <* char ':'+         <?> "prefix name"++{-+symbol ::=		|	explicituri+		|	qname+symbol_csl ::=		|	symbol symbol_csl_tail+		|	void+symbol_csl_tail ::=		|	 ","  symbol symbol_csl_tail+		|	void++-}++n3symbol :: N3Parser ScopedName+n3symbol = +  ((makeUriScopedName . showURI) <$> explicitURI)+  <|> qname+  <?> "symbol"++symbolCsl :: N3Parser [ScopedName]+symbolCsl = sepBy (lexeme n3symbol) comma++{-+qname ::=	(([A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*)?:)?[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*++Turtle appears to support ':' as a valid qname, which is not+supported by the above production. Let's support and see+what happens. This support may be removed since, if we allow+white space between : and prefix or local name then statements like+   : a : b : c .+are not parseable.++TODO:+  Note that, for now, we explicitly handle blank nodes+  (of the form _:name) direcly in pathItem'.+  This is not a good idea since qname' is used elsewhere+  and so shouldn't we do the same thing there too?+-}++qname :: N3Parser ScopedName+qname =+  (char ':' *> toSN getDefaultPrefix)+  <|> (n3Name >>= fullOrLocalQName)+  <?> "QName"+    where+      toSN p = ScopedName <$> p <*> (n3Name <|> return "")+          +fullOrLocalQName :: String -> N3Parser ScopedName+fullOrLocalQName name = +  (char ':' *> fullQName name)+  <|> localQName name+  +fullQName :: String -> N3Parser ScopedName+fullQName name = do+  pre <- findPrefix name+  lname <- n3Name <|> return ""+  return $ ScopedName pre lname+  +findPrefix :: String -> N3Parser Namespace+findPrefix pre = do+  st <- getState+  case mapFindMaybe pre (prefixUris st) of+    Just uri -> return $ Namespace pre uri+    Nothing  -> unexpected $ "Prefix '" ++ pre ++ ":' not bound."+  +localQName :: String -> N3Parser ScopedName+localQName name = do+  st <- getState+  if getAllowLocalNames st+    then do+      pre <- getDefaultPrefix+      return $ ScopedName pre name+    +    else fail "Invalid 'bare' word" -- TODO: not ideal error message; can we handle this case differently?++{-+existential ::=		|	 "@forSome"  symbol_csl++For now we just read in the symbols and ignore them,+since we do not mark blank nodes as existentially quantified+(we assume this is the case).++TODO: fix this?+-}++existential :: N3Parser ()+existential = try (atWord "forSome") *> symbolCsl >> return ()++{-+simpleStatement ::=		|	subject propertylist+-}++simpleStatement :: N3Parser ()+simpleStatement = subject >>= propertyListWith+  +{-+subject ::=		|	expression+-}++subject :: N3Parser RDFLabel+subject = lexeme expression++{-+expression ::=		|	pathitem pathtail+pathtail ::=		|	 "!"  expression+		|	 "^"  expression+		|	void++-}++expression :: N3Parser RDFLabel+expression = do+  i <- pathItem+  +  let backwardExpr = char '!' *> return addStatementRev +      forwardExpr  = char '^' *> return addStatement+  +  mpt <- optional+        ( (,) <$> lexeme (forwardExpr <|> backwardExpr) <*> lexeme expression )+  case mpt of+    Nothing -> return i +    Just (addFunc, pt) -> do+      bNode <- newBlankNode+      addFunc bNode pt i+      return bNode+  +{-+pathitem ::=		|	 "("  pathlist  ")" +		|	 "["  propertylist  "]" +		|	 "{"  formulacontent  "}" +		|	boolean+		|	literal+		|	numericliteral+		|	quickvariable+		|	symbol++pathlist ::=		|	expression pathlist+		|	void++Need to think about how to handle formulae, since need to know the context+of the call to know where to add them.++TOOD: may include direct support for blank nodes here,+namely convert _:stringval -> Blank stringval since although+this should be done by symbol the types don't seem to easily match+up (at first blush anyway)+-}++pathItem :: N3Parser RDFLabel+pathItem = +  br "(" ")" pathList+  <|> br "[" "]" propertyListBNode+  <|> br "{" "}" formulaContent+  <|> try boolean+  <|> literal+  <|> numericLiteral+  <|> quickVariable+  <|> Blank <$> (string "_:" *> n3Name) -- TODO a hack that needs fixing+  <|> Res <$> n3symbol+  <?> "pathitem"+  +{-  +we create a blank node for the list and return it, whilst+adding the list contents to the graph+-}+pathList :: N3Parser RDFLabel+pathList = do+  cts <- many (lexeme expression) <?> "pathlist"+  eNode <- operatorLabel rdf_nil+  case cts of+    [] -> return eNode+      +    (c:cs) -> do+      sNode <- newBlankNode+      first <- operatorLabel rdf_first+      addStatement sNode first c+      lNode <- foldM addElem sNode cs+      rest <- operatorLabel rdf_rest+      addStatement lNode rest eNode+      return sNode++    where      +      addElem prevNode curElem = do+        bNode <- newBlankNode+        first <- operatorLabel rdf_first+        rest <- operatorLabel rdf_rest+        addStatement prevNode rest bNode+        addStatement bNode first curElem+        return bNode+        +{-+formulacontent ::=		|	statementlist++statementlist ::=		|	statement statementtail+		|	void+statementtail ::=		|	 "."  statementlist+		|	void+-}++{-+We create a subgraph and assign it to a blank node, returning the+blank node. At present it is a combination of the subgraph and formula+productions from the origial parser.++TODO: is it correct?+-}+formulaContent :: N3Parser RDFLabel+formulaContent = do+  bNode <- newBlankNode+  pstate <- getState+  let fstate = pstate { graphState = emptyRDFGraph, thisNode = bNode }+  setState fstate+  statementList+  fstate' <- getState+  let nstate = pstate { nodeGen = nodeGen fstate' }+  setState nstate+  updateState $ updateGraph $ setFormula (Formula bNode (graphState fstate'))+  return bNode+  +-- need to work out what is going on here+subgraph :: RDFLabel -> N3Parser RDFGraph+subgraph = undefined++{-+subgraph :: RDFLabel -> N3Parser RDFGraph+subgraph this = do+  pstate <- getState+  let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }+  setState fstate       -- switch new state into parser+  statements            -- parse statements of formula+  fstate' <- getState+  let nstate = pstate { nodeGen = nodeGen fstate' }+  setState nstate       -- swap back state, with updated nodeGen+  return (graphState fstate')+-}++statementList :: N3Parser ()+statementList = ignore $ sepEndBy (lexeme statement) fullStop++{-+boolean ::=		|	 "@false" +		|	 "@true" +-}++boolean :: N3Parser RDFLabel+boolean = mkTypedLit xsd_boolean <$> +          (try (atWord "false") <|> atWord "true")+           +{-+dtlang ::=		|	 "@"  langcode+		|	 "^^"  symbol+		|	void+literal ::=		|	string dtlang++langcode ::=	[a-z]+(-[a-z0-9]+)*++-}++literal :: N3Parser RDFLabel+literal = Lit <$> n3string <*> optionMaybe dtlang+  +dtlang :: N3Parser ScopedName+dtlang = +  (char '@' *> langcode <?> "langcode")+  <|> (try (string "^^") *> n3symbol)+  <?> "dtlang"++langcode :: N3Parser ScopedName+langcode = do+  h <- many1 (oneOf ['a'..'z']) <?> "start of langcode (a to z)"+  mt <- optionMaybe ( (:) <$> char '-' <*> many1 (oneOf (['a'..'z'] ++ ['0'..'9']))) <?> "a to z or 0 to 9 (langcode after the hyphen)"+  return $ langName $ h ++ fromMaybe "" mt+    +{-+decimal ::=	[-+]?[0-9]+(\.[0-9]+)?+double ::=	[-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)+integer ::=	[-+]?[0-9]++numericliteral ::=		|	decimal+		|	double+		|	integer+-}++numericLiteral :: N3Parser RDFLabel+numericLiteral =+  try (mkTypedLit xsd_double <$> n3double)+  <|> try (mkTypedLit xsd_decimal <$> n3decimal)+  <|> mkTypedLit xsd_integer <$> n3integer+  <?> "numericliteral"++n3sign :: N3Parser Char+n3sign = char '+' <|> char '-'++n3integer :: N3Parser String+n3integer = do+  ms <- optionMaybe n3sign+  ds <- many1 digit+  case ms of+    Just s -> return $ s : ds+    _ -> return ds++n3decimal :: N3Parser String+n3decimal = (++) <$> n3integer <*> ( (:) <$> char '.' <*> many1 digit )+           +n3double :: N3Parser String  +n3double = (++) <$> n3decimal <*> ( (:) <$> oneOf "eE" <*> n3integer )++{-+propertylist ::=		|	verb object objecttail propertylisttail+		|	void+propertylisttail ::=		|	 ";"  propertylist+		|	void++-}++propertyListBNode :: N3Parser RDFLabel+propertyListBNode = do+  plist <- sepEndBy ((,) <$> lexeme verb <*> objectList) semiColon+  bNode <- newBlankNode+  let addList (vrb,items) = mapM_ (addItem vrb) items+      addItem (True,vrb) obj  = addStatement bNode vrb obj+      addItem (_,vrb)    subj = addStatement subj vrb bNode+  +  forM_ plist addList+  return bNode++propertyListWith :: RDFLabel -> N3Parser ()+propertyListWith subj = +  ignore $ sepEndBy (lexeme verb >>= objectListWith subj) semiColon+  +{-+object ::=		|	expression+objecttail ::=		|	 ","  object objecttail+		|	void++We change the production rule from objecttail to objectlist for lists of+objects (may change back)+-}++object :: N3Parser RDFLabel+object = lexeme expression++objectList :: N3Parser [RDFLabel]+objectList = sepBy1 object comma++objectWith :: RDFLabel -> (Bool, RDFLabel) -> N3Parser ()+objectWith subj (flag,vrb) = object >>= addFunc subj vrb+  where+    addFunc = if flag then addStatement else addStatementRev++objectListWith :: RDFLabel -> (Bool, RDFLabel) -> N3Parser ()+objectListWith subj vrb =+  ignore $ sepBy1 (objectWith subj vrb) comma++{-+objectList1 :: N3Parser [RDFLabel]+objectList1 = sepBy1 object comma+-}++{-+verb ::=		|	 "<=" +		|	 "=" +		|	 "=>" +		|	 "@a" +		|	 "@has"  expression+		|	 "@is"  expression  "@of" +		|	expression+-}++verb :: N3Parser (Bool, RDFLabel)+verb = +  -- we check reverse first so that <= is tried before looking for a URI via expression rule+  (,) False <$> verbReverse+  <|> (,) True <$> verbForward+  <?> "verb"++-- those verbs for which subject is on the right and object on the left+verbReverse :: N3Parser RDFLabel+verbReverse =+  try (string "<=") *> operatorLabel log_implies+  <|> between (try (atWord "is")) (atWord "of") (lexeme expression)++-- those verbs with subject on the left and object on the right+verbForward :: N3Parser RDFLabel+verbForward =  +  (try (string "=>") *> operatorLabel log_implies)+  <|> (string "=" *> operatorLabel owl_sameAs)+  <|> (try (atWord "a") *> operatorLabel rdf_type)+  <|> (atWord "has" *> lexeme expression)+  <|> lexeme expression++{-+universal ::=		|	 "@forAll"  symbol_csl++TODO: what needs to be done to support universal quantification+-}+universal :: N3Parser ()+universal = +  try (atWord "forAll") *> +  unexpected "universal (@forAll) currently unsupported." +  -- will be something like: *> symbolCsl++{-++-- OLD --+  +-- helper routines++isymbol :: String -> N3Parser ()+isymbol s = symbol s >> return ()++--  document         = directive* statement-list++document :: N3Parser RDFGraph+document = do+  whiteSpace+  _ <- many directive+  statements+  eof+  s <- getState+  return $ setNamespaces (prefixUris s) (graphState s)+    +--  directive        = "@prefix" prefix ":" uriRef2 "."   // Namespace declaration+--                   | "@prefix" ":" uriRef2 "."          // Default namespace+--                   | "@equivalence" uriRef2 "."         // Alternative to daml:equivalent+--                   | "@listfirst" uriRef2 "."           // Alternative to n3:first+--                   | "@listrest"  uriRef2 "."           // Alternative to n3:rest+--                   | "@listnull"  uriRef2 "."           // Alternative to n3:null+--                   | "@plus"  uriRef2 "."               // Alternative to operator:plus+--                   | "@minus" uriRef2 "."               // Alternative to operator:minus+--                   | "@slash" uriRef2 "."               // Alternative to operator:slash+--                   | "@star"  uriRef2 "."               // Alternative to operator:star+--                   | "@base"  uriRef2 "."               // Base URI for relative URIs.++directive :: N3Parser ()+directive = +  (try (symbol "@prefix") >> (defaultPrefix <|> namedPrefix))+  <|> (string "@" >> syntaxUri)+  <?> "directive"++defaultPrefix :: N3Parser ()+defaultPrefix = do+  u <- br ":" "." uriRef2+  updateState $ setPrefix "" (getScopedNameURI u)++namedPrefix :: N3Parser ()+namedPrefix = do+  n <- name+  u <- br ":" "." uriRef2+  updateState $ setPrefix n (getScopedNameURI u)+        +syntaxUri :: N3Parser ()+syntaxUri = do+  s <- uriName+  u <- uriRef2+  isymbol "."+  updateState $ setSUri s (getScopedNameURI u)+        +uriName :: N3Parser String+uriName =+  try (symbol "equivalence")+  <|> try (symbol "listfirst")+  <|> try (symbol "listrest")+  <|> try (symbol "listnull")+  <|> try (symbol "plus")+  <|> try (symbol "minus")+  <|> try (symbol "slash")+  <|> try (symbol "star")+  <|> try (symbol "base")+  <?> "special URI directive"+++--  statements       = [ statement ( "." statement )* ]+--+--  statement        = subject property-list+--+--  properties       = [ property ( ";" property )* ]+--+--  New statements are added to the user state graph++statements :: N3Parser ()+statements = sepEndBy1 statement (symbol ".") >> return ()++statement :: N3Parser ()+-- statement = subject >>= optional . properties  -- when using Parsec's optional+statement = subject >>= optional . properties >> return () -- not sure this is exactly the same as with Parsec++properties :: RDFLabel -> N3Parser ()+properties subj = sepBy1 (property subj) (symbol ";") >> return ()+++--  property         = verb object-list+--                   | ":-" anon-node           // Creates anon-node aongside the current node+--  verb             = ">-" prop "->"           // has 'prop' of+--                   | "<-" prop "<-"           // is  'prop' of+--                   | operator                 // has operator:'operator' of (???)+--                   | prop                     // has 'prop' of -- shorthand+--                   | "has" prop "of"          // has 'prop' of+--                   | "is" prop "of"           // is  'prop' of+--                   | "a"                      // has rdf:type of+--                   | "="                      // has daml:equivalent of+--+--  subj    is the subject node for these properties.+--+--  New statements are added to the graph in the parser's user state.++property :: RDFLabel -> N3Parser ()+property subj =+  (verb >>= uncurry (objects subj))+  <|>+  (isymbol ":-" >> anonNode subj >> return ())++verb :: N3Parser (RDFLabel,Bool)+verb = +  (prop >>= \p -> return (p, False))    +  <|> (operator >>= \p -> return (p, False))+  <|> (br ">-"  "->" prop >>= \p -> return (p, False))+  <|> (br "<-"  "<-" prop >>= \p -> return (p, True))+  <|> (br "has" "of" prop >>= \p -> return (p, False))+  <|> (br "is"  "of" prop >>= \p -> return (p, True))+  <|> (symbol "a" >> operatorLabel rdf_type   >>= \lab -> return (lab, False))+  <|> (symbol "=" >> operatorLabel owl_sameAs >>= \lab -> return (lab, False))+  <?> "property"+++--  objects          = object+--                   | object "," object-list+--+--  subj    is the subject node for the new statements,+--  prop    is the property node for the new statements.+--  swap    is true if the subject/object values in the resulting statement+--          are to be swapped (for "is <prop> of", etc.)+--+--  New statements are added to the graph in the parser's user state++objects :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()+objects subj ppty swap = +  sepBy1 (object subj ppty swap) (symbol ",") >> return ()++--  anonNode         = "[" property-list "]"    // Something with given properties+--                   | "{" statement-list "}"   // List of statements as resource+--                   | "(" node-list ")"        // Construct list with+--                                              //   rdf:first, rdf:rest, rdf:nil+--+--  subj    is the subject node with which the new anonymous node is equated,+--+--  The anonymous node value is returned by this parser (which is often the same+--  as the supplied subject node, but not always).+--+--  New statements are added to the graph in the parser's user state+--  (in the case of a formula, a new graph and parser are created, and+--  the graph arcs are added to this new graph).++anonNode :: RDFLabel -> N3Parser RDFLabel+anonNode subj =+  (br "[" "]" (properties subj) >> return subj)+  <|> br "{" "}" (formula subj)+  <|> br "(" ")" (nodeList subj)+  <?> "anon node (\"[\", \"(\" or \"{\")"++--  This method allows a statement list to be parsed as a subgraph+--  whose value is associated with the supplied node of the current+--  graph.++formula :: RDFLabel -> N3Parser RDFLabel+formula subj = do+  subgr <- subgraph subj+  updateState+    $ updateGraph+    $ setFormula (Formula subj subgr)+  return subj++subgraph :: RDFLabel -> N3Parser RDFGraph+subgraph this = do+  pstate <- getState+  let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }+  setState fstate       -- switch new state into parser+  statements            -- parse statements of formula+  fstate' <- getState+  let nstate = pstate { nodeGen = nodeGen fstate' }+  setState nstate       -- swap back state, with updated nodeGen+  return (graphState fstate')++--  prop             = uri-ref2+--                   | varid+--+--  Returns URI value as a Node++prop :: N3Parser RDFLabel+prop = nodeid <|> varid <|> uriNode+++--  operator         = "+"                      // >- operator:plus ->+--                   | "-"                      // >- operator:minus ->+--                   | "/"                      // >- operator:slash ->+--                   | "*"                      // >- operator:star->+--+--  If matched, the operator is returned as a node value.++operator :: N3Parser RDFLabel+operator =+  (symbol "+" >> operatorLabel operator_plus)+  <|> (symbol "-" >> operatorLabel operator_minus)+  <|> (symbol "*" >> operatorLabel operator_star)+  <|> (symbol "/" >> operatorLabel operator_slash)+  <?> ""++--  subject          = node++subject :: N3Parser RDFLabel+subject = node+++--  object           = litNode+--+--  This production adds a new triple to the graph state,+--  using the supplied subject and property values.+--  If swap is True, the subject and object positions are+--  swapped.++object :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()+object subj ppty True = do+  o <- litNode+  addStatement o ppty subj++object subj ppty _ = do+  o <- litNode+  addStatement subj ppty o+        +--  nodeList         = litNode*+--+--  subj    is the node from which the list is linked.+--+--  Returns the supplied head of list or Nil node allocated.+--+--  Link first element of link to list head, scan rest of list,+--  and return the list head;  otherwise return a node rdf_null.+--+--  This slightly convoluted pattern is to deal with two different+--  occurrences of a list node:+--    <node> :- ( l1, l2, ... )+--      Here, <node> (the supplied subj) is the listhead.+--    <node> prop ( l1, l2, ... )+--      Here, the a new blank is supplied as subj to be the listhead.+--  In either case, if the list is non-empty, the supplied subj+--  is returned.  But if the list is empty, a rdf_null node is returned.+--  In the second case, the invoking production must use the returned+--  value.++nodeList :: RDFLabel -> N3Parser RDFLabel+nodeList subj =+  (do+      val   <- litNode+      first <- operatorLabel rdf_first+      addStatement subj first val+      nodeList1 subj+      return subj)+  <|> operatorLabel rdf_nil+  <?> "Node or ')'"++nodeList1 :: RDFLabel -> N3Parser ()+nodeList1 prev =+  (do+      val   <- litNode+      lnk   <- newBlankNode+      first <- operatorLabel rdf_first+      rest  <- operatorLabel rdf_rest+      addStatement lnk  first val+      addStatement prev rest  lnk+      nodeList1 lnk)+  <|> (do +          nil   <- operatorLabel rdf_nil+          rest  <- operatorLabel rdf_rest+          addStatement prev rest nil)+  <?> "Node or ')'"+++--  lit-node         = node+--                   | str-node [ "@" lang ] [ "^^" uriRef2 ]+--  str-node         = '"' constant-value '"'+--                   | '"""' constant value '"""'   // Including single or double occurences of+--                                                  //   quotes and/or newlines+--+--  Returns a new node value.++litNode :: N3Parser RDFLabel+litNode = +  node+  <|> liftM2 Lit strNode litTypeOrLang+  <?> "URI, blank node or literal"++strNode :: N3Parser String+strNode =+        tripleQuoteString+    <|> singleQuoteString+++litTypeOrLang :: N3Parser (Maybe ScopedName)+litTypeOrLang =+        langTag+    <|> typeUri+    <|> return Nothing+    <?> "'@tag' (language tag) or '^^name' (datatype URI)"++langTag :: N3Parser (Maybe ScopedName)+langTag =+  fmap (Just . langName) (string "@" >> name)+  <?> "'@tag' (language tag)"+                                               +typeUri :: N3Parser (Maybe ScopedName)+typeUri =+  fmap Just (string "^^" >> uriRef2)+  <?> "'^^name' (datatype URI)"++--  node             = nodeid+--                   | varid+--                   | uri-ref2+--                   | anon-node+--+--  nodeid           = "_:" name+--+--  varid            = "?" name+--+--  Returns a new node value.++node :: N3Parser RDFLabel+node =  nodeid+    <|> varid+    <|> uriNode+    <|> (newBlankNode >>= anonNode)+    <?> "URI or blank node"++--  Identified blank node in input+--+--  Note that automatically generated blank node identifiers start with+--  a digit, where input node identifiers start with a letter, so there+--  can be no clash.  Care is needed when serializing a graph to ensure+--  that future clashes are avoided.++nodeid :: N3Parser RDFLabel+-- nodeid = lexeme nodeid1+nodeid = fmap Blank (string "_:" >> name)++--  variable identifier++varid :: N3Parser RDFLabel+varid = fmap Var (string "?" >> name)++--  uriNode          = qname+--                   | "<" URI-reference ">"+--                   | "this"++uriNode :: N3Parser RDFLabel+uriNode = +  fmap Res uriRef2+  <|> fmap thisNode (string "this" >> getState)+  <?> "URI node"+++--  uriRef2          = qname+--                   | ":" local-name+--                   | "<" URI-reference ">"+--  qname            = prefix ":" local-name+--+--  prefix           = name                         // Namespace prefix+--+--  local-name       = name                         // Local name (namespace qualified)+--+--  name             = alpha alphanumeric*+--+--  alpha            = "a"-"z"+--                   | "A"-"Z"+--                   | "_"+--+--  alphanumeric     = alpha+--                   | "0"-"9"+--+--  URI-reference    = (conforming to syntax in RFC2396)+--+--  uriRef2 returns a ScopedName.++uriRef2 :: N3Parser ScopedName+uriRef2 = lexeme (try uriRef2a)+    <?> "URI or QName"++uriRef2a :: N3Parser ScopedName+uriRef2a =+  liftM2 ScopedName prefix (colon >> localname)+  <|> (colon >> liftM2 ScopedName defaultprefix localname)+  <|> fmap makeUriScopedName absUriRef+  <?> "URI or QName"++prefix :: N3Parser Namespace+prefix = do+  pref <- prefixname+  st   <- getState+  return (getPrefixNs st pref)   -- map prefix to namespace++defaultprefix :: N3Parser Namespace+defaultprefix = do+  st <- getState+  return (getPrefixNs st "")++name :: N3Parser String+name =  lexeme $ name1 identStart++prefixname :: N3Parser String+prefixname =  name1 identStart++localname :: N3Parser String+localname =  lexeme $ name1 identLetter++--  'name1' is a name without following whitespace+--  initChar is a parser for the first character+name1 :: N3Parser Char -> N3Parser String+name1 initChar =+  liftM2 (:) initChar (many identLetter)+  <?> "identifier"+++----------------------------------------------------------------------+-- Lexical support+----------------------------------------------------------------------+--+-- The following code adapted from ParsecToken,+-- modified to handle different escape conventions and triple-quoted strings+--      \c+--      \uhhhh+--      \Uhhhhhhhh+--+-- Regular single-quoted string -- cannot be split over line breaks++singleQuoteString :: N3Parser String+singleQuoteString =+    lexeme+    (   between (char '"') (char '"' <?> "end of string (\")") anyStringChars+    <?> "literal string" )++anyStringChars :: CharParser st String+anyStringChars = +  fmap (foldr (maybe id (:)) "") (many stringChar)+      +-- Triple-quoted string -- may include line breaks, '"' or '""'.+tripleQuoteString :: N3Parser String+tripleQuoteString =+    lexeme+    (fmap (foldr (++) "") $ between (try $ string "\"\"\"")+                                    (string "\"\"\"" <?> "end of string (\"\"\")")+                                    (many tripleQuoteSubstring))+    <?> "triple-quoted literal string"++-- Match non-quote substring or one or two quote characters+tripleQuoteSubstring :: N3Parser String+tripleQuoteSubstring =+        tripleQuoteSubstring1+    <|> try sqTripleQuoteSubstring1+    <|> try dqTripleQuoteSubstring1++dqTripleQuoteSubstring1 :: N3Parser String+dqTripleQuoteSubstring1 = +  fmap ("\"\""++) $ string "\"\"" >> tripleQuoteSubstring1++sqTripleQuoteSubstring1 :: N3Parser String+sqTripleQuoteSubstring1 =+  fmap ('"':) $ char '"' >> tripleQuoteSubstring1++-- match at least one non-quote character in a triple-quoted string+tripleQuoteSubstring1 :: N3Parser String+tripleQuoteSubstring1 =+  fmap (foldr (maybe id (:)) "") $ many1 tripleQuoteStringChar++tripleQuoteStringChar :: CharParser st (Maybe Char)+tripleQuoteStringChar =+  stringChar <|> (string "\n" >> return (Just '\n'))++stringChar :: CharParser st (Maybe Char)+stringChar =+  fmap Just stringLetter+  <|> stringEscape+  <?> "string character"++stringLetter :: CharParser st Char+stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c >= '\032'))++stringEscape :: CharParser st (Maybe Char)+stringEscape =+  fmap Just $ char '\\' >> escapeCode++-- escape codes+escapeCode :: CharParser st Char+escapeCode = charEsc <|> charUCS2 <|> charUCS4 <?> "escape code"++-- \c+charEsc :: CharParser st Char+charEsc = choice (map parseEsc escMap)+        where+            parseEsc (c,code) = fmap (const code) (char c)+            escMap            = zip "nrt\\\"\'" "\n\r\t\\\"\'"++-- \uhhhh+charUCS2 :: CharParser st Char+charUCS2 =+  fmap chr $ char 'u' >> numberFW 16 hexDigit 4 0++-- \Uhhhhhhhh+charUCS4 :: CharParser st Char+charUCS4 =+  fmap chr $ char 'U' >> numberFW 16 hexDigit 8 0++-- parse fixed-width number:+numberFW :: Int -> CharParser st Char -> Int -> Int -> CharParser st Int+numberFW _    _         0     val = return val+numberFW base baseDigit width val = do+  d <- baseDigit+  numberFW base baseDigit (width-1) (val*base + digitToInt d)+++----------------------------------------------------------------------+--  Parse a URI reference from the input+--  The result returned has absolute form;  relative URIs are resolved+--  relative to the current base prefix (set using "@base").+--++--  lexeme version+lexUriRef :: N3Parser String+lexUriRef = lexeme absUriRef++-- from Swish.Utils.ProcessURI+absoluteUriPart :: String -- ^ URI base+                   -> String -- ^ URI reference+                   -> String+absoluteUriPart base rel = showURI $ fromJust $ relativeTo (fromJust (parseURIReference rel)) (fromJust (parseURI base))+  +absUriRef :: N3Parser String+absUriRef = do+  u <- between (char '<') (char '>' <?> "end of URI '>'") anyUriChars+  if isURI u+    then return u+    else if isURIReference u+         then do+           s <- getState+           return $ absoluteUriPart (getSUri s "base") u+         else fail ("Invalid URI: <"++u++">")++anyUriChars :: N3Parser String+anyUriChars = many uriChar++uriChar :: N3Parser Char+uriChar =+        alphaNum+    <|> oneOf "[];?:@&=+$,-_.!~*'()%//#"+    <?> "URI character"++-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/NTFormatter.hs view
@@ -0,0 +1,217 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  N3Formatter+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module implements a NTriples formatter (see [1])+--  for an RDFGraph value.+--+--+-- REFERENCES:+--+-- 1 <http://www.w3.org/TR/rdf-testcases/#ntriples>+--     RDF Test Cases+--     W3C Recommendation 10 February 2004+--+--------------------------------------------------------------------------------++module Swish.RDF.NTFormatter+    ( NodeGenLookupMap+    , formatGraphAsString+    , formatGraphAsShowS+    )+where++import Swish.RDF.RDFGraph+  ( RDFGraph, RDFLabel(..)+  , getArcs+  )++import Swish.RDF.GraphClass+    ( Arc(..) )++import Swish.Utils.Namespace (ScopedName(..), nsURI)+import Swish.RDF.Vocabulary (isLang, langTag)++import Swish.Utils.LookupMap+    ( LookupMap, emptyLookupMap+    , mapFind, mapAdd+    )++import Text.Printf (printf)+import Data.Char (ord)++-- import "mtl" Control.Monad.State+import Control.Monad.State++----------------------------------------------------------------------+--  Graph formatting state monad+----------------------------------------------------------------------+--+--  This is a lot simpler than other formatters.++--  | Node name generation state information that carries through+--  and is updated by nested formulae+type NodeGenLookupMap = LookupMap (RDFLabel,Int)++data NTFormatterState = NTFS { +      ntfsNodeMap :: NodeGenLookupMap,+      ntfsNodeGen :: Int+    } deriving Show++emptyNTFS :: NTFormatterState+emptyNTFS = NTFS {+              ntfsNodeMap = emptyLookupMap,+              ntfsNodeGen = 0+              }++type Formatter a = State NTFormatterState a++----------------------------------------------------------------------+--  Define a top-level formatter function:+--  accepts a graph and returns a string+----------------------------------------------------------------------++formatGraphAsString :: RDFGraph -> String+formatGraphAsString gr = formatGraphAsShowS gr "\n"++formatGraphAsShowS :: RDFGraph -> ShowS+formatGraphAsShowS gr = +    let (out, _, _) = formatGraphInternal gr+    in out ++formatGraphInternal :: RDFGraph -> (ShowS, NodeGenLookupMap, Int)+formatGraphInternal gr = +    let (out, st) = runState (formatGraph gr) emptyNTFS+    in (out, ntfsNodeMap st, ntfsNodeGen st)++----------------------------------------------------------------------+--  Formatting as a monad-based computation+----------------------------------------------------------------------++-- Are there better ways to do this (could look at moving to a Builder+-- style system)?+-- +applyShowS :: [ShowS] -> ShowS+applyShowS = foldr (.) id++formatGraph :: RDFGraph -> Formatter ShowS+formatGraph gr = do+  ls <- mapM formatArc (getArcs gr)+  return $ applyShowS ls++formatArc :: Arc RDFLabel -> Formatter ShowS+formatArc (Arc s p o) = do+  sl <- formatLabel s+  pl <- formatLabel p+  ol <- formatLabel o+  return $ applyShowS $ map showString [sl, " ", pl, " ", ol, " .\n"]++{-+If we have a blank node then can++  - use the label it contains+  - generate a new one on output++For now we create new labels whatever the input was since this+simplifies things, but it may be changed.++formatLabel :: RDFLabel -> Formatter String+formatLabel lab@(Blank (lnc:_)) = +  if isDigit lnc then mapBlankNode lab else return $ show lab+formatLabel lab = return $ show lab+-}++formatLabel :: RDFLabel -> Formatter String+formatLabel lab@(Blank _) = mapBlankNode lab+formatLabel (Res sn) = return $ showScopedName sn+formatLabel (Lit lit Nothing) = return $ quoteStr lit+formatLabel (Lit lit (Just nam)) | isLang nam = return $ quoteStr lit ++ "@" ++ langTag nam+                                 | otherwise  = return $ quoteStr lit ++ "^^" ++ showScopedName nam++-- do not expect to get the following, but include+-- just in case rather than failing+formatLabel lab = return $ show lab++mapBlankNode :: RDFLabel -> Formatter String+mapBlankNode lab = do+  st <- get+  let cmap = ntfsNodeMap st+      cval = ntfsNodeGen st++  nv <- case mapFind 0 lab cmap of+            0 -> do+              let nval = succ cval+                  nmap = mapAdd cmap (lab, nval)++              put $ st { ntfsNodeMap = nmap, ntfsNodeGen = nval }+              return nval++            n -> return n++  return $ "_:swish" ++ show nv++showScopedName :: ScopedName -> String+showScopedName (ScopedName n l) = +  let uri = nsURI n ++ l+  in "<" ++ quote uri ++ ">"++{-+Swish.Utils.MiscHelpers contains a quote routine+which we expand upon here to match the NT syntax.+-}++quoteStr :: String -> String+quoteStr  st = ['"'] ++ quote st ++ ['"']++quote :: String -> String+quote []           = ""+quote ('\\':st)    = '\\':'\\': quote st+quote ('"': st)    = '\\':'"': quote st+quote ('\n':st)    = '\\':'n': quote st+quote ('\r':st)    = '\\':'r': quote st+quote ('\t':st)    = '\\':'t': quote st+quote (c:st) = +  let nc = ord c+      rst = quote st+      +      -- lazy way to convert to a string+      hstr = printf "%08X" nc+      ustr = hstr ++ rst++  in if nc > 0xffff +     then '\\':'U': ustr+     else if nc > 0x7e || nc < 0x20+          then '\\':'u': drop 4 ustr+          else c : rst+                      +--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/NTParser.hs view
@@ -0,0 +1,401 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  NTParser+--  Copyright   :  (c) 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module implements a NTriples parser (see [1]), returning a+--  new 'RDFGraph' consisting of triples and namespace information parsed from+--  the supplied NTriples input string, or an error indication.+--+--  Uses the Parsec monadic parser library.+--+-- REFERENCES:+--+-- 1 <http://www.w3.org/TR/rdf-testcases/#ntriples>+--     RDF Test Cases+--     W3C Recommendation 10 February 2004+--+--------------------------------------------------------------------------------++module Swish.RDF.NTParser+    ( ParseResult+    , parseNT      +    , parsefromString+    +    -- * Exports for parsers that embed NTriples in a bigger syntax+    , NTParser, NTState(..)+    , ntripleDoc+    , line, ws, comment, eoln+    , character, name, triple+    , subject, predicate, object+    , uriref, urirefLbl+    , nodeID, literal, language++    )+where++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , addArc +    , emptyRDFGraph+    )++import Swish.RDF.GraphClass+    ( arc )++import Swish.Utils.Namespace+    ( ScopedName(..)+    , makeUriScopedName+    )++import Swish.RDF.Vocabulary (langName)++import Swish.RDF.RDFParser+    ( ParseResult, RDFParser+    , ignore+    , annotateParsecError+    )++import Control.Applicative+import Control.Monad (when)++import Network.URI (parseURI)++import Data.Char (chr) +import Data.Maybe (fromMaybe, isNothing)++import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))++----------------------------------------------------------------------+-- Define parser state and helper functions+----------------------------------------------------------------------++-- | NT parser state+data NTState = NTState+        { graphState :: RDFGraph            -- Graph under construction+        }++--  Return function to update graph in NT parser state,+--  using the supplied function of a graph+--  (use returned function with Parsec updateState)+updateGraph :: ( RDFGraph -> RDFGraph ) -> NTState -> NTState+updateGraph f s = s { graphState = f (graphState s) }++----------------------------------------------------------------------+--  Define top-level parser function:+--  accepts a string and returns a graph or error+----------------------------------------------------------------------++type NTParser a = RDFParser NTState a++-- | Parse a string.+-- +parseNT ::+  String -- ^ input in NTriples format.+  -> ParseResult+parseNT = parsefromString ntripleDoc+-- parseNT = either Error Result . parsefromString ntripleDoc++{-+-- useful for testing+test :: String -> RDFGraph+test = either error id . parsefromString ntripleDoc+-}++-- | Function to supply initial context and parse supplied term.+--+-- We augment the Parsec error with the context.+--+parsefromString :: +    NTParser a      -- ^ parser to apply+    -> String       -- ^ input to be parsed+    -> Either String a+parsefromString parser input =+        let+            pstate = NTState+                    { graphState = emptyRDFGraph+                    }+            result = runParser parser pstate "" input+        in+            case result of+                Right res -> Right res+                Left  err -> Left $ annotateParsecError 1 (lines input) err++-- helper routines++fullStop :: NTParser ()+fullStop = ignore (char '.')++{-+lineFeed :: NTParser ()+lineFeed = ignore (char '\r')+-}++-- Add statement to graph in NT parser state++addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> NTParser ()+addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))++----------------------------------------------------------------------+--  Syntax productions+----------------------------------------------------------------------++{-++EBNF from the specification, using the notation from XML 1.0, second edition,+is included inline below.++We do not force ASCII 7-bit semantics here yet.++space	::=	#x20 /* US-ASCII space - decimal 32 */	+cr	::=	#xD /* US-ASCII carriage return - decimal 13 */	+lf	::=	#xA /* US-ASCII line feed - decimal 10 */	+tab	::=	#x9 /* US-ASCII horizontal tab - decimal 9 */	++The productions are kept as close as possible to the specification+for now.++-}++{-+ntripleDoc	::=	line*	+line	::=	ws* ( comment | triple )? eoln	++We relax the rule that the input must be empty or end with a new line.++ntripleDoc :: NTParser RDFGraph+ntripleDoc = graphState <$> (many line *> eof *> getState)++line :: NTParser ()+line = skipMany ws *> optional (comment <|> triple) *> eoln+-}++ntripleDoc :: NTParser RDFGraph+ntripleDoc = graphState <$> (sepBy line eoln *> optional eoln *> skipMany ws *> eof *> getState)++line :: NTParser ()+line = skipMany ws *> ignore (optional (comment <|> triple))++{-+ws	::=	space | tab	++Could use whiteSpace rule here, but that would permit+constructs (e.g. comments) where we do not support them.+-}+ws :: NTParser ()+ws = ignore (char ' ' <|> tab) <?> "white space (' ' or tab)"++{-+comment	::=	'#' ( character - ( cr | lf ) )*	+-}++comment :: NTParser ()+comment = char '#' *> skipMany (noneOf "\r\n") <?> "comment line"++{-+eoln	::=	cr | lf | cr lf	+-}++eoln :: NTParser ()+-- eoln = ignore (newline <|> (lineFeed *> optional newline))+eoln = ignore (try (string "\r\n") <|> string "\r" <|> string "\n")+       <?> "new line"+       +{-+name	::=	[A-Za-z][A-Za-z0-9]*	+-}++hChars, bChars :: String+hChars = ['a'..'z'] ++ ['A'..'Z']+bChars = hChars ++ ['0'..'9']++name :: NTParser String+name = (:) <$> oneOf hChars <*> many (oneOf bChars)++{-+triple	::=	subject ws+ predicate ws+ object ws* '.' ws*	++-}++triple :: NTParser ()+triple = do+  s <- subject+  skipMany1 ws+  p <- predicate+  skipMany1 ws+  o <- object+  skipMany ws+  fullStop+  skipMany ws+  addStatement s p o++{-+subject	::=	uriref | nodeID	+predicate	::=	uriref	+object	::=	uriref | nodeID | literal	+-}++subject :: NTParser RDFLabel+subject = urirefLbl <|> nodeID++predicate :: NTParser RDFLabel+predicate = urirefLbl++object :: NTParser RDFLabel+object = urirefLbl <|> nodeID <|> literal++{-+uriref	::=	'<' absoluteURI '>'	+absoluteURI	::=	character+ with escapes as defined in section URI References	++-}++uriref :: NTParser ScopedName+uriref = do+  ustr <- char '<' *> manyTill character (char '>')+  when (isNothing (parseURI ustr)) $+    fail ("Invalid URI: <" ++ ustr ++ ">")+  return $ makeUriScopedName ustr++urirefLbl :: NTParser RDFLabel+urirefLbl = Res <$> uriref++{-+nodeID	::=	'_:' name	+-}++nodeID :: NTParser RDFLabel+nodeID = Blank <$> (string "_:" *> name) <?> "blank node (_:label)"++{-  +literal	::=	langString | datatypeString	+langString	::=	'"' string '"' ( '@' language )?	+datatypeString	::=	'"' string '"' '^^' uriref	+language	::=	[a-z]+ ('-' [a-z0-9]+ )*+encoding a language tag.	+string	::=	character* with escapes as defined in section Strings	++-}++literal :: NTParser RDFLabel+literal = Lit <$> between (char '"') (char '"') (many character) <*> optionMaybe dtlang++dtlang :: NTParser ScopedName+dtlang = +    (char '@' *> language)+    <|> (string "^^" *> uriref)++language :: NTParser ScopedName+language = do+  h <- many1 (oneOf ['a'..'z'])+  mt <- optionMaybe ( (:) <$> char '-' <*> many1 (oneOf (['a'..'z'] ++ ['0'..'9'])) )+  return $ langName $ h ++ fromMaybe "" mt++{-+String handling: ++EBNF has:++character	::=	[#x20-#x7E] /* US-ASCII space to decimal 126 */	++Additional information from:++  http://www.w3.org/TR/rdf-testcases/#ntrip_strings++N-Triples strings are sequences of US-ASCII character productions encoding [UNICODE] character strings. The characters outside the US-ASCII range and some other specific characters are made available by \-escape sequences as follows:++ Unicode character+ (with code point u)	N-Triples encoding+ [#x0-#x8]	\uHHHH+ 4 required hexadecimal digits HHHH encoding Unicode character u+ #x9	\t+ #xA	\n+ [#xB-#xC]	\uHHHH+ 4 required hexadecimal digits HHHH encoding Unicode character u+ #xD	\r+ [#xE-#x1F]	\uHHHH+ 4 required hexadecimal digits HHHH encoding Unicode character u+ [#x20-#x21]	the character u+ #x22	\"+ [#x23-#x5B]	the character u+ #x5C	\\+ [#x5D-#x7E]	the character u+ [#x7F-#xFFFF]	\uHHHH+ 4 required hexadecimal digits HHHH encoding Unicode character u+ [#10000-#x10FFFF]	\UHHHHHHHH+ 8 required hexadecimal digits HHHHHHHH encoding Unicode character u+ where H is a hexadecimal digit: [#x30-#x39],[#x41-#x46] (0-9, uppercase A-F).++This escaping satisfies the [CHARMOD] section Reference Processing Model on making the full Unicode character range U+0 to U+10FFFF available to applications and providing only one way to escape any character.++-}++asciiChars :: String+asciiChars = map chr [0x20..0x7e]++asciiCharsNT :: String+asciiCharsNT = filter (`notElem` "\\\"") asciiChars++ntHexDigit :: NTParser Char+ntHexDigit = oneOf $ ['0'..'9'] ++ ['A'..'F']++hex4 :: NTParser Char+hex4 = do+  digs <- count 4 ntHexDigit+  let dstr = "0x" ++ digs+      dchar = read dstr :: Int+  return $ chr dchar+        +hex8 :: NTParser Char+hex8 = do+  digs <- count 8 ntHexDigit+  let dstr = "0x" ++ digs+      dchar = read dstr :: Int+  if dchar <= 0x10FFFF+    then return $ chr dchar+    else unexpected "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"++protectedChar :: NTParser Char+protectedChar =+  (char 't' *> return '\t')+  <|> (char 'n' *> return '\n')+  <|> (char 'r' *> return '\r')+  <|> (char '"' *> return '"')+  <|> (char '\\' *> return '\\')+  <|> (char 'u' *> hex4)+  <|> (char 'U' *> hex8)++character :: NTParser Char+character = (char '\\' *> protectedChar)+      <|> (oneOf asciiCharsNT <?> "ASCII character")++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/Proof.hs view
@@ -0,0 +1,278 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Proof+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines a framework for constructing proofs+--  over some expression form.  It is intended to be used+--  with RDF graphs, but the structures aim to be quite+--  generic with respect to the expression forms allowed.+--+--  It does not define any proof-finding strategy.+--+--------------------------------------------------------------------------------++module Swish.RDF.Proof+    ( Proof(..), Step(..)+    , checkProof, explainProof, checkStep, showProof, showsProof, showsFormula )+where++import Swish.RDF.Ruleset+    ( Ruleset(..) )++import Swish.RDF.Rule+    ( Expression(..), Formula(..), Rule(..)+    , showsFormula, showsFormulae )++import Swish.Utils.ShowM+    ( ShowM(..) )++import Swish.Utils.ListHelpers+    ( subset )++import Data.List+    ( union, intersect, intercalate )++import Data.Maybe+    ( catMaybes )+++------------------------------------------------------------+--  Proof framework+------------------------------------------------------------++-- |Step in proof chain+--+--  The display name for a proof step comes from the display name of its+--  consequence formula.+data Step ex = Step+    { stepRule :: Rule ex           -- ^ Inference rule used+    , stepAnt  :: [Formula ex]      -- ^ Antecedents of inference rule+    , stepCon  :: Formula ex        -- ^ Named consequence of inference rule+    } deriving Show++-- |Proof is a structure that presents a chain of rule applications+--  that yield a result expression from a given expression+data Proof ex = Proof+    { proofContext :: [Ruleset ex]  -- ^ Proof context:  list of rulesets,+                                    --   each of which provides a number of+                                    --   axioms and rules.+    , proofInput   :: Formula ex    -- ^ Given expression+    , proofResult  :: Formula ex    -- ^ Result expression+    , proofChain   :: [Step ex]     -- ^ Chain of inference rule applications+                                    --   progressing from input to result+    }++-- |Return a list of axioms from all the rulesets in a proof+proofAxioms :: Proof a -> [Formula a]+proofAxioms = concatMap rsAxioms . proofContext++-- |Return a list of rules from all the rulesets in a proof+proofRules :: Proof a -> [Rule a]+proofRules = concatMap rsRules . proofContext++-- |Return list of axioms actually referenced by a proof+proofAxiomsUsed :: Proof ex -> [Formula ex]+proofAxiomsUsed proof = foldl union [] $ map stepAxioms (proofChain proof)+    where+        stepAxioms st = stepAnt st `intersect` proofAxioms proof++-- |Check consistency of given proof.+--  The supplied rules and axioms are assumed to be correct.+checkProof :: (Expression ex) => Proof ex -> Bool+checkProof pr =+    checkProof1 (proofRules pr) initExpr (proofChain pr) goalExpr+    where+        initExpr = formExpr (proofInput pr) : map formExpr (proofAxioms pr)+        goalExpr = formExpr $ proofResult pr++checkProof1 :: (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool+checkProof1 _     prev []       res = res `elem` prev+checkProof1 rules prev (st:steps) res =+    checkStep rules prev st &&+    checkProof1 rules (formExpr (stepCon st):prev) steps res++--  A proof step is valid if rule is in list of rules+--  and the antecedents are sufficient to obtain the conclusion+--  and the antecedents are in the list of formulae already proven.+--+--  Note:  this function depends on the ruleName of any rule being+--  unique among all rules.  In particular the name of the step rule+--  being in correspondence with the name of one of the indicated+--  valid rules of inference.+checkStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Bool+checkStep rules prev step =+    -- Rule name is one of supplied rules, and+    (ruleName srul `elem` map ruleName rules) &&+    -- Antecedent expressions are all previously accepted expressions+    (sant `subset` prev)   &&+    -- Inference rule yields concequence from antecendents+    checkInference srul sant scon+    where+        --  Rule from proof step:+        srul = stepRule step+        --  Antecedent expressions from proof step:+        sant = map formExpr $ stepAnt step+        --  Consequentent expression from proof step:+        scon = formExpr $ stepCon step+++{-+    (formExpr (stepCon step) `elem` sfwd)+    -- (or $ map (`subset` sant) sbwd)+    where+        --  Rule from proof step:+        srul = stepRule step+        --  Antecedent expressions from proof step:+        sant = map formExpr $ stepAnt step+        --  Forward chaining from antecedents of proof step+        scon = map formExpr $ stepCon step+        --  Forward chaining from antecedents of proof step++        sfwd = fwdApply srul sant+        --  Backward chaining from consequent of proof step+        --  (Does not work because of introduction of existentials)+        sbwd = bwdApply srul (formExpr $ stepCon step)+-}++-- |Check proof, and return identification of failing step.+explainProof ::+    (Expression ex) => Proof ex -> Maybe String+explainProof pr =+    explainProof1 (proofRules pr) initExpr (proofChain pr) goalExpr+    where+        initExpr = formExpr (proofInput pr) : map formExpr (proofAxioms pr)+        goalExpr = formExpr $ proofResult pr++explainProof1 ::+    (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String+explainProof1 _     prev []       res   =+    if res `elem` prev then Nothing else Just "Result not demonstrated"+explainProof1 rules prev (st:steps) res =+    case explainStep rules prev st  of+        Nothing -> explainProof1 rules (formExpr (stepCon st):prev) steps res+        Just ex -> Just ("Invalid step: "++show (formName $ stepCon st)++": "++ex)++--  A proof step is valid if rule is in list of rules+--  and the antecedents are sufficient to obtain the conclusion+--  and the antecedents are in the list of formulae already proven.+--+--  Note:  this function depends on the ruleName of any rule being+--  unique among all rules.  In particular the name of the step rule+--  being in correspondence with the name of one of the indicated+--  valid rules of inference.+--+--  Return Nothing if step is OK, or Just string describing failure+--+explainStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Maybe String+explainStep rules prev step =+        if null errors then Nothing else Just $ intercalate ", " errors+    where+        --  Rule from proof step:+        srul = stepRule step+        --  Antecedent expressions from proof step:+        sant = map formExpr $ stepAnt step+        --  Consequentent expression from proof step:+        scon = formExpr $ stepCon step+        --  Tests for step to be valid+        errors = catMaybes+            -- Rule name is one of supplied rules, and+            [ require (ruleName srul `elem` map ruleName rules)+                      ("rule "++show (ruleName srul)++" not present")+            -- Antecedent expressions are all previously accepted expressions+            , require (sant `subset` prev)+                      "antecedent not axiom or previous result"+            -- Inference rule yields consequence from antecedents+            , require (checkInference srul sant scon)+                      "rule does not deduce consequence from antecedents"+            ]+        require b s = if b then Nothing else Just s++-- |Create a displayable form of a proof, returned as a `ShowS` value.+--+--  This function is intended to allow the calling function some control+--  of multiline displays by providing:+--+--  (1) the first line of the proof is not preceded by any text, so+--      it may be appended to some preceding text on the same line,+--+--  (2) the supplied newline string is used to separate lines of the+--      formatted text, and may include any desired indentation, and+--+--  (3) no newline is output following the final line of text.+showsProof :: (ShowM ex) => String -> Proof ex -> ShowS+showsProof newline proof =+    if null axioms then shProof else shAxioms . shProof+    where+        axioms = proofAxiomsUsed proof+        shAxioms =+            showString    ("Axioms:" ++ newline) .+            showsFormulae newline (proofAxiomsUsed proof) newline+        shProof =+            showString    ("Input:" ++ newline) .+            showsFormula  newline (proofInput  proof) .+            showString    (newline ++ "Proof:" ++ newline) .+            showsSteps    newline (proofChain  proof)++-- |Returns a simple string representation of a proof.+showProof :: (ShowM ex) => String -> Proof ex -> String+showProof newline proof = showsProof newline proof ""++-- |Create a displayable form of a list of labelled proof steps+showsSteps :: (ShowM ex) => String -> [Step ex] -> ShowS+showsSteps _       []     = id+showsSteps newline [s]    = showsStep  newline s+showsSteps newline (s:ss) = showsStep  newline s .+                            showString newline .+                            showsSteps newline ss++-- |Create a displayable form of a labelled proof step.+showsStep :: (ShowM ex) => String -> Step ex -> ShowS+showsStep newline s = showsFormula newline (stepCon s) .+                      showString newline .+                      showString ("  (by ["++rulename++"] from "++antnames++")")+    where+        rulename = show . ruleName $ stepRule s+        antnames = showNames $ map (show . formName) (stepAnt s)++-- |Return a string containing a list of names.+showNames :: [String] -> String+showNames []      = "<nothing>"+showNames [n]     = showName n+showNames [n1,n2] = showName n1 ++ " and " ++ showName n2+showNames (n1:ns) = showName n1 ++ ", " ++ showNames ns++-- |Return a string representing a single name.+showName :: String -> String+showName n = "["++n++"]"++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFDatatype.hs view
@@ -0,0 +1,221 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFDatatype+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines the structures used by Swish to represent and+--  manipulate RDF datatypes.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFDatatype+    ( RDFDatatype+    , RDFDatatypeVal+    , RDFDatatypeMod+    , RDFModifierFn, RDFApplyModifier+    , makeRdfDtOpenVarBindingModify, makeRdfDtOpenVarBindingModifiers+    , applyRDFDatatypeMod+    , RDFDatatypeSub+    , fromRDFLabel, toRDFLabel, makeDatatypedLiteral+    )+where++import Swish.RDF.RDFGraph+    ( RDFLabel(..)+    , isDatatyped+    , getLiteralText+    , RDFGraph+    )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding, RDFOpenVarBindingModify )++import Swish.RDF.Datatype+    ( Datatype -- , typeName, typeRules+    , DatatypeVal(..)+    , DatatypeMap(..)+    , DatatypeMod(..), ModifierFn+    , ApplyModifier+    , DatatypeSub(..)+    )++import Swish.Utils.Namespace+    ( ScopedName(..) )++import Swish.RDF.VarBinding+    ( VarBindingModify(..) )++import Data.Maybe+    ( fromMaybe, isJust, fromJust )++import Control.Monad+    ( liftM )++------------------------------------------------------------+--  Specialize datatype framework types for use with RDF+------------------------------------------------------------++-- |RDF datatype wrapper used with RDF graph values+--+type RDFDatatype = Datatype RDFGraph RDFLabel RDFLabel++-- |RDF datatype value used with RDF graph values+--+type RDFDatatypeVal vt = DatatypeVal RDFGraph vt RDFLabel RDFLabel++-- |RDF datatype modifier used with RDF graph values+--+type RDFDatatypeMod vt = DatatypeMod vt RDFLabel RDFLabel++-- |Describe a subtype/supertype relationship between a pair+--  of RDF datatypes.+--+type RDFDatatypeSub supvt subvt = DatatypeSub RDFGraph RDFLabel RDFLabel supvt subvt++-- |RDF value modifier function type+--+--  This indicates a modifier function that operates on 'RDFLabel' values.+--+type RDFModifierFn = ModifierFn RDFLabel++-- |RDF value modifier application function type+--+--  This indicates a function that applies RDFModifierFn functions.+--+type RDFApplyModifier = ApplyModifier RDFLabel RDFLabel++--------------------------------------------------------------+--  Functions for creating datatype variable binding modifiers+--------------------------------------------------------------++-- |Create an 'RDFOpenVarBindingModify' value.+--+--  The key purpose of this function is to lift the supplied+--  variable constraint functions from operating on data values directly+--  to a corresponding list of functions that operate on values contained+--  in RDF graph labels (i.e. RDF literal nodes).  It also applies+--  node type checking, such that if the actual RDF nodes supplied do+--  not contain appropriate values then the variable binding is not+--  accepted.+--+makeRdfDtOpenVarBindingModify ::+    RDFDatatypeVal vt+    -- ^ is an 'RDFDatatype' value containing details of the datatype+    --   for which a variable binding modifier is created.+    -> RDFDatatypeMod vt +    -- ^ is the data value modifier value that defines the calculations+    --   that are used to implement a variable binding modifier.+    -> RDFOpenVarBindingModify+makeRdfDtOpenVarBindingModify dtval dtmod =+    dmAppf dtmod (dmName dtmod) $ map (makeRDFModifierFn dtval) (dmModf dtmod)++-- |Create all RDFOpenVarBindingModify values for a given datatype value.+--  See 'makeRdfDtOpenVarBindingModify'.+--+makeRdfDtOpenVarBindingModifiers ::+    RDFDatatypeVal vt +    -- ^  is an 'RDFDatatype' value containing details of the datatype+    --    for which variable binding modifiers are created.+    -> [RDFOpenVarBindingModify]+makeRdfDtOpenVarBindingModifiers dtval =+    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)++-- |Apply a datatype modifier using supplied RDF labels to a supplied+--  RDF variable binding.+--+applyRDFDatatypeMod ::+    RDFDatatypeVal vt -> RDFDatatypeMod vt -> [RDFLabel] -> [RDFVarBinding]+    -> [RDFVarBinding]+applyRDFDatatypeMod dtval dtmod lbs =+    vbmApply (makeRdfDtOpenVarBindingModify dtval dtmod lbs)++-- |Given details of a datatype and a single value constraint function,+--  return a new constraint function that operates on 'RDFLabel' values.+--+--  The returned constraint function incorporates checks for appropriately+--  typed literal nodes, and returns similarly typed literal nodes.+--+makeRDFModifierFn ::+    RDFDatatypeVal vt -> ModifierFn vt -> RDFModifierFn+makeRDFModifierFn dtval fn ivs =+    let+        ivals = mapM (rdfNodeExtract dtval) ivs+        ovals | isJust ivals = fn (fromJust ivals)+              | otherwise    = []+    in+        fromMaybe [] $ mapM (rdfNodeInject dtval) ovals++-- |Extract datatyped value from 'RDFLabel' value, or return @Nothing@.+--+rdfNodeExtract :: RDFDatatypeVal vt -> RDFLabel -> Maybe vt+rdfNodeExtract dtval node+    | isDatatyped dtname node = mapL2V dtmap $ getLiteralText node+    | otherwise               = Nothing+    where+        dtname = tvalName dtval+        dtmap  = tvalMap  dtval++-- |Return new RDF literal node with a representation of the supplied+--  value, or @Nothing@.+--+rdfNodeInject :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel+rdfNodeInject dtval val = maybeNode valstr+    where+        valstr = mapV2L (tvalMap  dtval) val+        maybeNode Nothing    = Nothing+        maybeNode (Just str) = Just $ Lit str (Just (tvalName dtval))++------------------------------------------------------------+--  Helpers to map between datatype values and RDFLabels+------------------------------------------------------------++fromRDFLabel ::+    RDFDatatypeVal vt -> RDFLabel -> Maybe vt+fromRDFLabel dtv lab+    | isDatatyped dtnam lab = mapL2V dtmap $ getLiteralText lab+    | otherwise             = Nothing+    where+        dtnam = tvalName dtv+        dtmap = tvalMap dtv++toRDFLabel :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel+toRDFLabel dtv =+    liftM (makeDatatypedLiteral dtnam) . mapV2L dtmap+    where+        dtnam = tvalName dtv+        dtmap = tvalMap dtv++makeDatatypedLiteral :: ScopedName -> String -> RDFLabel+makeDatatypedLiteral dtnam strval =+    Lit strval (Just dtnam)++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFDatatypeXsdInteger.hs view
@@ -0,0 +1,544 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFDatatypeXsdInteger+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines the structures used by swish to represent and+--  manipulate RDF datatypes.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFDatatypeXsdInteger+    ( rdfDatatypeXsdInteger+    , rdfDatatypeValXsdInteger+    , typeNameXsdInteger, namespaceXsdInteger+    , axiomsXsdInteger, rulesXsdInteger+    , prefixXsdInteger+    )+where++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleset +    , makeRDFGraphFromN3String+    , makeRDFFormula+    )++import Swish.RDF.RDFDatatype+    ( RDFDatatype+    , RDFDatatypeVal+    , RDFDatatypeMod+    , makeRdfDtOpenVarBindingModifiers+    )++import Swish.RDF.ClassRestrictionRule+    ( makeRDFDatatypeRestrictionRules+    )++import Swish.RDF.MapXsdInteger+    ( mapXsdInteger+    )++import Swish.RDF.Datatype+    ( Datatype(..)+    , DatatypeVal(..)+    , DatatypeRel(..), DatatypeRelPr+    , altArgs+    , UnaryFnTable,    unaryFnApp+    , BinaryFnTable,   binaryFnApp+    , BinMaybeFnTable, binMaybeFnApp+    , DatatypeMod(..) +    , makeVmod_1_1_inv, makeVmod_1_1+    , makeVmod_2_1_inv, makeVmod_2_1+    , makeVmod_2_0+    , makeVmod_2_2+    )++import Swish.RDF.Ruleset (makeRuleset)++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , namespaceXSD+    , namespaceXsdType+    )++import Data.Maybe (maybeToList)++import Control.Monad (liftM)++------------------------------------------------------------+--  Misc values+------------------------------------------------------------++--  Local name for Integer datatype+nameXsdInteger :: String+nameXsdInteger      = "integer"++-- |Type name for xsd:integer datatype+typeNameXsdInteger :: ScopedName+typeNameXsdInteger  = ScopedName namespaceXSD nameXsdInteger++-- |Namespace for xsd:integer datatype functions+namespaceXsdInteger :: Namespace+namespaceXsdInteger = namespaceXsdType nameXsdInteger++--  Helper to catenate strings with newline separator,+--  used for making textual representations of graphs.+--  (the newline makes N3 parser diagnostics easier to interpret)+--+infixr 5 ++++(+++) :: String -> ShowS+(+++) str = ((str++"\n")++)++--  Compose with function of two arguments+c2 :: (b -> c) -> (a -> d -> b) -> a -> d -> c+c2 = (.) . (.)++--  Integer power (exponentiation) function+--  returns Nothing if exponent is negative.+--+intPower :: Integer -> Integer -> Maybe Integer+intPower a b = if b < 0 then Nothing else Just (intPower1 a b)+    where+        intPower1 x y+            | q == 1           = atopsq*x+            | p == 0           = 1+            | otherwise        = atopsq+            where+                (p,q)  = y `divMod` 2+                atop   = intPower1 x p+                atopsq = atop*atop++------------------------------------------------------------+--  Declare exported RDFDatatype value for xsd:integer+------------------------------------------------------------++rdfDatatypeXsdInteger :: RDFDatatype+rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger++------------------------------------------------------------+--  Implmentation of RDFDatatypeVal for xsd:integer+------------------------------------------------------------++-- |Define Datatype value for xsd:integer+--  Members of this datatype are positive or negative integer values.+--+--  The lexical form consists of an option @+@ or @-@+--  followed by a sequence of decimal digits.+--+--  The canonical lexical form has leading zeros and @+@ sign removed.+--+rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer+rdfDatatypeValXsdInteger = DatatypeVal+    { tvalName      = typeNameXsdInteger+    , tvalRules     = rdfRulesetXsdInteger  -- Ruleset RDFGraph+    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger+                                            -- RDFGraph -> [RDFRules]+    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger+    , tvalMap       = mapXsdInteger         -- DatatypeMap Integer+    , tvalRel       = relXsdInteger         -- [DatatypeRel Integer]+    , tvalMod       = modXsdInteger         -- [DatatypeMod Integer]+    }++-- |relXsdInteger contains arithmetic and other relations for xsd:Integer values.+--+--  The functions are inspired by those defined by CWM as math: properties.+--  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)+--++relXsdInteger :: [DatatypeRel Integer]+relXsdInteger =+    [ relXsdIntegerAbs+    , relXsdIntegerNeg+    , relXsdIntegerSum+    , relXsdIntegerDiff+    , relXsdIntegerProd+    , relXsdIntegerDivMod+    , relXsdIntegerPower+    , relXsdIntegerEq+    , relXsdIntegerNe+    , relXsdIntegerLt+    , relXsdIntegerLe+    , relXsdIntegerGt+    , relXsdIntegerGe+    ]++mkIntRel2 ::+    String -> DatatypeRelPr Integer -> UnaryFnTable Integer+    -> DatatypeRel Integer+mkIntRel2 nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdInteger nam+    , dtRelFunc = altArgs pr fns unaryFnApp+    }++mkIntRel3 ::+    String -> DatatypeRelPr Integer -> BinaryFnTable Integer+    -> DatatypeRel Integer+mkIntRel3 nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdInteger nam+    , dtRelFunc = altArgs pr fns binaryFnApp+    }++mkIntRel3maybe ::+    String -> DatatypeRelPr Integer -> BinMaybeFnTable Integer+    -> DatatypeRel Integer+mkIntRel3maybe nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdInteger nam+    , dtRelFunc = altArgs pr fns binMaybeFnApp+    }++relXsdIntegerAbs :: DatatypeRel Integer+relXsdIntegerAbs = mkIntRel2 "abs" (const True)+    [ ( (>=0),      [ (abs,1) ] )+    , ( const True, [ (id,0), (negate,0) ] )+    ]++relXsdIntegerNeg :: DatatypeRel Integer+relXsdIntegerNeg = mkIntRel2 "neg" (const True)+    [ ( const True, [ (negate,1) ] )+    , ( const True, [ (negate,0) ] )+    ]++relXsdIntegerSum :: DatatypeRel Integer+relXsdIntegerSum = mkIntRel3 "sum" (const True)+    [ ( const True, [ ((+),1,2) ] )+    , ( const True, [ ((-),0,2) ] )+    , ( const True, [ ((-),0,1) ] )+    ]++relXsdIntegerDiff :: DatatypeRel Integer+relXsdIntegerDiff = mkIntRel3 "diff" (const True)+    [ ( const True, [ ((-),1,2) ] )+    , ( const True, [ ((+),0,2) ] )+    , ( const True, [ ((-),1,0) ] )+    ]++relXsdIntegerProd :: DatatypeRel Integer+relXsdIntegerProd = mkIntRel3 "prod" (const True)+    [ ( const True, [ ((*),1,2) ] )+    , ( const True, [ (div,0,2) ] )+    , ( const True, [ (div,0,1) ] )+    ]++relXsdIntegerDivMod :: DatatypeRel Integer+relXsdIntegerDivMod = mkIntRel3 "divmod" (const True)+    [ ( const True, [ (div,2,3) ] )+    , ( const True, [ (mod,2,3) ] )+    , ( const True, [ ] )+    , ( const True, [ ] )+    ]++relXsdIntegerPower :: DatatypeRel Integer+relXsdIntegerPower = mkIntRel3maybe "power" (const True)+    [ ( const True, [ (liftM (:[]) `c2` intPower,1,2) ] )+    , ( const True, [ ] )+    , ( (>=0),      [ ] )+    ]++liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool+liftL2 p i1 i2 as = p (i1 as) (i2 as)++lcomp :: (a->a->Bool) -> [a] -> Bool+lcomp p = liftL2 p head (head . tail)++-- eq++relXsdIntegerEq :: DatatypeRel Integer+relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==))+    ( repeat (const True, []) )++-- ne++relXsdIntegerNe :: DatatypeRel Integer+relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=))+    ( repeat (const True, []) )++-- lt++relXsdIntegerLt :: DatatypeRel Integer+relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<))+    ( repeat (const True, []) )++-- le++relXsdIntegerLe :: DatatypeRel Integer+relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=))+    ( repeat (const True, []) )++-- gt++relXsdIntegerGt :: DatatypeRel Integer+relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>))+    ( repeat (const True, []) )++-- ge++relXsdIntegerGe :: DatatypeRel Integer+relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=))+    ( repeat (const True, []) )++-- |modXsdInteger contains variable binding modifiers for xsd:Integer values.+--+--  The functions are selected from those defined by CWM as math:+--  properties.+--  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)+--+modXsdInteger :: [RDFDatatypeMod Integer]+modXsdInteger =+    [ modXsdIntegerAbs+    , modXsdIntegerNeg+    , modXsdIntegerSum+    , modXsdIntegerDiff+    , modXsdIntegerProd+    , modXsdIntegerDivMod+    , modXsdIntegerPower+    , modXsdIntegerEq+    , modXsdIntegerNe+    , modXsdIntegerLt+    , modXsdIntegerLe+    , modXsdIntegerGt+    , modXsdIntegerGe+    ]++modXsdIntegerAbs :: RDFDatatypeMod Integer+modXsdIntegerAbs = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "abs"+    , dmModf = [ f0, f1 ]+    , dmAppf = makeVmod_1_1+    }+    where+        f0 vs@[v1,v2] = if v1 == abs v2 then vs else []+        f0 _          = []+        f1 [v2]       = [abs v2]+        f1 _          = []++modXsdIntegerNeg :: RDFDatatypeMod Integer+modXsdIntegerNeg = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "neg"+    , dmModf = [ f0, f1, f1 ]+    , dmAppf = makeVmod_1_1_inv+    }+    where+        f0 vs@[v1,v2] = if v1 == negate v2 then vs else []+        f0 _          = []+        f1 [vi]       = [-vi]+        f1 _          = []++modXsdIntegerSum :: RDFDatatypeMod Integer+modXsdIntegerSum = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "sum"+    , dmModf = [ f0, f1, f2, f2 ]+    , dmAppf = makeVmod_2_1_inv+    }+    where+        f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []+        f0 _             = []+        f1 [v2,v3]       = [v2+v3]+        f1 _             = []+        f2 [v1,vi]       = [v1-vi]+        f2 _             = []++modXsdIntegerDiff :: RDFDatatypeMod Integer+modXsdIntegerDiff = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "diff"+    , dmModf = [ f0, f1, f2, f3 ]+    , dmAppf = makeVmod_2_1_inv+    }+    where+        f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []+        f0 _             = []+        f1 [v2,v3]       = [v2-v3]+        f1 _             = []+        f2 [v1,v3]       = [v1+v3]+        f2 _             = []+        f3 [v1,v2]       = [v2-v1]+        f3 _             = []++modXsdIntegerProd :: RDFDatatypeMod Integer+modXsdIntegerProd = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "prod"+    , dmModf = [ f0, f1, f2, f2 ]+    , dmAppf = makeVmod_2_1_inv+    }+    where+        f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []+        f0 _             = []+        f1 [v2,v3]       = [v2*v3]+        f1 _             = []+        f2 [v1,vi]       = if r == 0 then [q] else []+            where (q,r)  = quotRem v1 vi+        f2 _             = []++modXsdIntegerDivMod :: RDFDatatypeMod Integer+modXsdIntegerDivMod = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "divmod"+    , dmModf = [ f0, f1 ]+    , dmAppf = makeVmod_2_2+    }+    where+        f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else []+        f0 _                = []+        f1 [v3,v4]          = [v1,v2] where (v1,v2) = divMod v3 v4+        f1 _                = []++modXsdIntegerPower :: RDFDatatypeMod Integer+modXsdIntegerPower = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger "power"+    , dmModf = [ f0, f1 ]+    , dmAppf = makeVmod_2_1+    }+    where+        f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else []+        f0 _             = []+        f1 [v2,v3]       = maybeToList (intPower v2 v3)+        f1 _             = []++modXsdIntegerEq, modXsdIntegerNe, modXsdIntegerLt, modXsdIntegerLe, modXsdIntegerGt, modXsdIntegerGe :: RDFDatatypeMod Integer +modXsdIntegerEq = modXsdIntegerCompare "eq" (==)+modXsdIntegerNe = modXsdIntegerCompare "ne" (/=)+modXsdIntegerLt = modXsdIntegerCompare "lt" (<)+modXsdIntegerLe = modXsdIntegerCompare "le" (<=)+modXsdIntegerGt = modXsdIntegerCompare "gt" (>)+modXsdIntegerGe = modXsdIntegerCompare "ge" (>=)++modXsdIntegerCompare ::+    String -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer+modXsdIntegerCompare nam rel = DatatypeMod+    { dmName = ScopedName namespaceXsdInteger nam+    , dmModf = [ f0 ]+    , dmAppf = makeVmod_2_0+    }+    where+        f0 vs@[v1,v2] = if rel v1 v2 then vs else []+        f0 _          = []++-- |rulesetXsdInteger contains rules and axioms that allow additional+--  deductions when xsd:integer values appear in a graph.+--+--  The rules defined here are concerned with basic integer arithmetic+--  operations: +, -, *, div, rem+--+--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex+--+rdfRulesetXsdInteger :: RDFRuleset+rdfRulesetXsdInteger =+    makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger++mkPrefix :: Namespace -> String+mkPrefix ns =+    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"++prefixXsdInteger :: String+prefixXsdInteger =+    mkPrefix namespaceRDF  +++    mkPrefix namespaceRDFS +++    mkPrefix namespaceRDFD +++    mkPrefix namespaceXSD  +++    mkPrefix namespaceXsdInteger +++    " \n"++mkAxiom :: String -> String -> RDFFormula+mkAxiom local gr =+    makeRDFFormula namespaceXsdInteger local (prefixXsdInteger++gr)++axiomsXsdInteger :: [RDFFormula]+axiomsXsdInteger =+    [ mkAxiom "dt"      "xsd:integer rdf:type rdfs:Datatype ."+    ]++rulesXsdInteger :: [RDFRule]+rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr+    where+        gr = makeRDFGraphFromN3String rulesXsdIntegerStr++rulesXsdIntegerStr :: String+rulesXsdIntegerStr = prefixXsdInteger+    +++ "xsd_integer:Abs a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:abs ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Neg a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:neg ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Sum a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+    +++ "  rdfd:constraint xsd_integer:sum ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Diff a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+    +++ "  rdfd:constraint xsd_integer:diff ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Prod a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+    +++ "  rdfd:constraint xsd_integer:prod ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:DivMod a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "+    +++ "  rdfd:constraint xsd_integer:divmod ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Power a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+    +++ "  rdfd:constraint xsd_integer:power ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Eq a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:eq ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Ne a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:ne ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Lt a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:lt ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Le a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:le ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Gt a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:gt ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_integer:Ge a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_integer:ge ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFDatatypeXsdString.hs view
@@ -0,0 +1,347 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFDatatypeXsdString+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines the structures used by swish to represent and+--  manipulate RDF xsd:string datatyped literals.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFDatatypeXsdString+    ( rdfDatatypeXsdString+    , rdfDatatypeValXsdString+    , typeNameXsdString, namespaceXsdString+    , axiomsXsdString, rulesXsdString+    , prefixXsdString+    )+where++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleset+    , makeRDFGraphFromN3String+    , makeRDFFormula+    , makeN3ClosureRule+    )++import Swish.RDF.RDFVarBinding+    ( RDFVarBindingModify+    )++import Swish.RDF.RDFDatatype+    ( RDFDatatype+    , RDFDatatypeVal+    , RDFDatatypeMod+    , makeRdfDtOpenVarBindingModifiers+    )++import Swish.RDF.RDFGraph+    ( RDFLabel(..) )++import Swish.RDF.ClassRestrictionRule+    ( makeRDFDatatypeRestrictionRules+    )++import Swish.RDF.Datatype+    ( Datatype(..)+    , DatatypeVal(..)+    , DatatypeMap(..)+    , DatatypeRel(..), DatatypeRelPr+    , altArgs+    , UnaryFnTable,  unaryFnApp+    , DatatypeMod(..) +    , makeVmod_2_0+    )++import Swish.RDF.Ruleset+    ( makeRuleset +    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , namespaceXSD+    , namespaceXsdType+    )++import Swish.RDF.VarBinding+    ( VarBinding(..)+    , addVarBinding+    , VarBindingModify(..)+    )++------------------------------------------------------------+--  Misc values+------------------------------------------------------------++--  Local name for Integer datatype+nameXsdString :: String+nameXsdString      = "string"++-- |Type name for @xsd:string@ datatype+typeNameXsdString :: ScopedName+typeNameXsdString  = ScopedName namespaceXSD nameXsdString++-- |Namespace for @xsd:string@ datatype functions+namespaceXsdString :: Namespace+namespaceXsdString = namespaceXsdType nameXsdString++--  Helper to catenate strings with newline separator,+--  used for making textual representations of graphs.+--  (the newline makes N3 parser diagnostics easier to interpret)+--+infixr 5 ++++(+++) :: String -> ShowS+(+++) str = ((str++"\n")++)++------------------------------------------------------------+--  Declare exported RDFDatatype value for xsd:integer+------------------------------------------------------------++rdfDatatypeXsdString :: RDFDatatype+rdfDatatypeXsdString = Datatype rdfDatatypeValXsdString++------------------------------------------------------------+--  Implmentation of RDFDatatypeVal for xsd:integer+------------------------------------------------------------++-- |Define Datatype value for @xsd:string@.+--+rdfDatatypeValXsdString :: RDFDatatypeVal String+rdfDatatypeValXsdString = DatatypeVal+    { tvalName      = typeNameXsdString+    , tvalRules     = rdfRulesetXsdString  -- Ruleset RDFGraph+    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString+                                           -- RDFGraph -> [RDFRules]+    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString+    , tvalMap       = mapXsdString         -- DatatypeMap Integer+    , tvalRel       = relXsdString         -- [DatatypeRel Integer]+    , tvalMod       = modXsdString         -- [DatatypeMod Integer]+    }++-- |mapXsdString contains functions that perform lexical-to-value+--  and value-to-canonical-lexical mappings for @xsd:string@ values+--+--  These are identity mappings.+--+mapXsdString :: DatatypeMap String+mapXsdString = DatatypeMap+    { -- mapL2V :: String -> Maybe String+      mapL2V = Just+      -- mapV2L :: String -> Maybe String+    , mapV2L = Just+    }++-- |relXsdString contains useful relations for @xsd:string@ values.+--+relXsdString :: [DatatypeRel String]+relXsdString =+    [ relXsdStringEq+    , relXsdStringNe+    ]++mkStrRel2 ::+    String -> DatatypeRelPr String -> UnaryFnTable String+    -> DatatypeRel String+mkStrRel2 nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdString nam+    , dtRelFunc = altArgs pr fns unaryFnApp+    }++{-+mkStrRel3 ::+    String -> DatatypeRelPr String -> BinaryFnTable String+    -> DatatypeRel String+mkStrRel3 nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdString nam+    , dtRelFunc = altArgs pr fns binaryFnApp+    }++mkStrRel3maybe ::+    String -> DatatypeRelPr String -> BinMaybeFnTable String+    -> DatatypeRel String+mkStrRel3maybe nam pr fns = DatatypeRel+    { dtRelName = ScopedName namespaceXsdString nam+    , dtRelFunc = altArgs pr fns binMaybeFnApp+    }+-}++liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool+liftL2 p i1 i2 as = p (i1 as) (i2 as)++lcomp :: (a->a->Bool) -> [a] -> Bool+lcomp p = liftL2 p head (head . tail)++-- eq++relXsdStringEq :: DatatypeRel String+relXsdStringEq = mkStrRel2 "eq" (lcomp (==))+    ( repeat (const True, []) )++-- ne++relXsdStringNe :: DatatypeRel String+relXsdStringNe = mkStrRel2 "ne" (lcomp (/=))+    ( repeat (const True, []) )++-- |modXsdString contains variable binding modifiers for @xsd:string@ values.+--+modXsdString :: [RDFDatatypeMod String]+modXsdString =+    [ modXsdStringEq+    , modXsdStringNe+    ]++modXsdStringEq, modXsdStringNe :: RDFDatatypeMod String+modXsdStringEq = modXsdStringCompare "eq" (==)+modXsdStringNe = modXsdStringCompare "ne" (/=)++modXsdStringCompare ::+    String -> (String->String->Bool) -> RDFDatatypeMod String+modXsdStringCompare nam rel = DatatypeMod+    { dmName = ScopedName namespaceXsdString nam+    , dmModf = [ f0 ]+    , dmAppf = makeVmod_2_0+    }+    where+        f0 vs@[v1,v2] = if rel v1 v2 then vs else []+        f0 _          = []++-- |rulesetXsdString contains rules and axioms that allow additional+--  deductions when xsd:string values appear in a graph.+--+--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex+--+rdfRulesetXsdString :: RDFRuleset+rdfRulesetXsdString =+    makeRuleset namespaceXsdString axiomsXsdString rulesXsdString++mkPrefix :: Namespace -> String+mkPrefix ns =+    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"++prefixXsdString :: String+prefixXsdString =+    mkPrefix namespaceRDF  +++    mkPrefix namespaceRDFS +++    mkPrefix namespaceRDFD +++    mkPrefix namespaceXSD  +++    mkPrefix namespaceXsdString +++    " \n"++mkAxiom :: String -> String -> RDFFormula+mkAxiom local gr =+    makeRDFFormula namespaceXsdString local (prefixXsdString++gr)++axiomsXsdString :: [RDFFormula]+axiomsXsdString =+    [ mkAxiom "dt"      "xsd:string rdf:type rdfs:Datatype ."+    ]++rulesXsdString :: [RDFRule]+rulesXsdString = rulesXsdStringClosure ++ rulesXsdStringRestriction++rulesXsdStringRestriction :: [RDFRule]+rulesXsdStringRestriction =+    makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString gr+    where+        gr = makeRDFGraphFromN3String rulesXsdStringStr++rulesXsdStringStr :: String+rulesXsdStringStr = prefixXsdString+    +++ "xsd_string:Eq a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_string:eq ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+    +++ "xsd_string:Ne a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "+    +++ "  rdfd:constraint xsd_string:ne ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "++rulesXsdStringClosure :: [RDFRule]+rulesXsdStringClosure =+    [ xsdstrls+    , xsdstrsl+    ]++--  Infer string from plain literal+xsdstrls :: RDFRule+xsdstrls = makeN3ClosureRule namespaceXsdString "ls"+            "?a ?p ?l ."+            "?a ?p ?s ."+            (stringPlain "s" "l")++--  Infer plain literal from string+xsdstrsl :: RDFRule+xsdstrsl = makeN3ClosureRule namespaceXsdString "sl"+            "?a ?p ?s ."+            "?a ?p ?l ."+            (stringPlain "s" "l")++--  Map between string and plain literal values+stringPlain :: String -> String -> RDFVarBindingModify+stringPlain svar lvar = stringPlainValue (Var svar) (Var lvar)++--  Variable binding modifier to create new binding to a canonical+--  form of a datatyped literal.+stringPlainValue ::+    RDFLabel -> RDFLabel -> RDFVarBindingModify+stringPlainValue svar lvar = VarBindingModify+        { vbmName   = ScopedName namespaceRDFD "stringPlain"+        , vbmApply  = concatMap app1+        , vbmVocab  = [svar,lvar]+        , vbmUsage  = [[svar],[lvar],[]]+        }+    where+        app1 vbind = app2 (vbMap vbind svar) (vbMap vbind lvar) vbind+        app2 (Just (Lit s (Just _)))+             (Just (Lit l Nothing))+             vbind+             | s == l+             = [vbind]+        app2 (Just (Lit s (Just _)))+             Nothing+             vbind+             = [addVarBinding lvar (Lit s Nothing) vbind]+        app2 Nothing+             (Just (Lit l Nothing))+             vbind+             = [addVarBinding svar (Lit l (Just typeNameXsdString)) vbind]+        app2 _ _ _ = []++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFGraph.hs view
@@ -0,0 +1,649 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFGraph+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances+--+--  This module defines a memory-based RDF graph instance.+--+--------------------------------------------------------------------------------++------------------------------------------------------------+-- Simple labelled directed graph value+------------------------------------------------------------++module Swish.RDF.RDFGraph+    ( RDFLabel(..)+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral+    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar+    , getLiteralText, getScopedName, makeBlank+    , RDFTriple+    , NSGraph(..), RDFGraph+    , NamespaceMap, RevNamespaceMap, RevNamespace+    , emptyNamespaceMap+    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap+    , addArc, merge+    , allLabels, allNodes, remapLabels, remapLabelList+    , newNode, newNodes+    , setNamespaces, getNamespaces+    , setFormulae, getFormulae, setFormula, getFormula+    , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}+      -- Re-export from GraphClass+    , LDGraph(..), Label (..), Arc(..)+    , arc, arcSubj, arcPred, arcObj, Selector+      -- Export selected RDFLabel values+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil+    , res_rdfs_member+    , res_rdfd_GeneralRestriction+    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality+    , res_owl_sameAs, res_log_implies+      -- Exported for testing:+    , grMatchMap, grEq+    , mapnode, maplist+    )+where++import Swish.Utils.Namespace+    ( Namespace(..)+    , getScopedNameURI+    , ScopedName(..)+    , nullScopedName+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , langTag, isLang+    , rdf_type+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral+    , rdfs_member+    , rdfd_GeneralRestriction+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality+    , owl_sameAs, log_implies+    )++import Swish.RDF.GraphClass+    ( LDGraph(..), Label (..)+    , Arc(..), arc, arcSubj, arcPred, arcObj+    , Selector )++import Swish.RDF.GraphMatch+    ( graphMatch, LabelMap, ScopedLabel(..) )++import Swish.Utils.MiscHelpers+    ( hash, quote )++import Swish.Utils.ListHelpers+    ( addSetElem )++import Swish.Utils.LookupMap+    ( LookupMap(..), LookupEntryClass(..)+    , listLookupMap+    , mapFind, mapFindMaybe, mapReplaceOrAdd, mapVals, mapKeys )++import qualified Data.Foldable as F+import qualified Data.Traversable as T++import Control.Applicative (Applicative, liftA, (<$>), (<*>))+-- import Control.Monad (liftM, ap)++import Data.Char+    ( isDigit )++import Data.List+    ( intersect, union, findIndices )++import Data.Ord (comparing)++-----------------------------------------------------------+-- | RDF graph node values+--+--  cf. <http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax>+--+--  This is extended from the RDF abstract graph syntax in the+--  following ways:+--+--  (a) a graph can be part of a resource node or blank node+--      (cf. Notation3 formulae)+--+--  (b) a \"variable\" node option is distinguished from a+--      blank node.+--      I have found this useful for encoding and handling+--      queries, even though query variables can be expressed+--      as blank nodes.+--+--  (c) a \"NoNode\" option is defined.+--      This might otherwise be handled by @Maybe (RDFLabel g)@.+--++-- TODO: should Lit be split up so that can easily differentiate between+-- a type and a language tag++data RDFLabel =+      Res ScopedName                    -- ^ resource+    | Lit String (Maybe ScopedName)     -- ^ literal [type/language]+    | Blank String                      -- ^ blank node+    | Var String                        -- ^ variable (not used in ordinary graphs)+    | NoNode                            -- ^ no node  (not used in ordinary graphs)++instance Eq RDFLabel where+    (==) = labelEq++instance Show RDFLabel where+    show (Res sn)           = show sn+    show (Lit st Nothing)   = quote st+    show (Lit st (Just nam))+        | isLang nam = quote st ++ "@"  ++ langTag nam+        | otherwise  = quote st ++ "^^" ++ show nam+    show (Blank ln)         = "_:"++ln+    show (Var ln)           = '?' : ln+    show NoNode             = "<NoNode>"++instance Ord RDFLabel where+    -- Optimize some common cases..+    compare (Res sn1)      (Res sn2)      = compare sn1 sn2+    compare (Blank ln1)    (Blank ln2)    = compare ln1 ln2+    compare (Res _)        (Blank _)      = LT+    compare (Blank _)      (Res _)        = GT+    -- .. else use show string comparison+    compare l1 l2 = comparing show l1 l2+    -- Similarly for <=+    (Res qn1)   <= (Res qn2)      = qn1 <= qn2+    (Blank ln1) <= (Blank ln2)    = ln1 <= ln2+    (Res _)     <= (Blank _)      = True+    (Blank _)   <= (Res _)        = False+    l1 <= l2                      = show l1 <= show l2++instance Label RDFLabel where+    labelIsVar (Blank _)    = True+    labelIsVar (Var _)      = True+    labelIsVar _            = False+    getLocal   (Blank loc)  = loc+    getLocal   (Var   loc)  = '?':loc+    getLocal   (Res   sn)   = "Res_"++snLocal sn+    getLocal   (NoNode)     = "None"+    getLocal   _            = "Lit_"+    makeLabel  ('?':loc)    = Var loc+    makeLabel  loc          = Blank loc+    labelHash seed lb       = hash seed (showCanon lb)++-- | Get the canonical string for RDF label.+--+--  Used for hashing, so that equivalent labels always return+--  the same hash value.+    +showCanon :: RDFLabel -> String+showCanon (Res sn)           = "<"++getScopedNameURI sn++">"+showCanon (Lit st (Just nam))+        | isLang nam = quote st ++ "@"  ++ langTag nam+        | otherwise  = quote st ++ "^^" ++ getScopedNameURI nam+showCanon s                  = show s+++-- | Define equality of nodes possibly based on different graph types.+--+-- The version of equality defined here is not strictly RDF abstract syntax+-- equality, but my interpretation of equivalence for the purposes of+-- entailment, in the absence of any specific datatype knowledge other+-- than XML literals.+--+labelEq :: RDFLabel -> RDFLabel -> Bool+labelEq (Res q1)            (Res q2)        = q1 == q2+labelEq (Blank s1)          (Blank s2)      = s1 == s2+labelEq (Var v1)            (Var v2)        = v1 == v2+labelEq (Lit s1 t1)         (Lit s2 t2)     = s1 == s2 && t1 == t2+labelEq _                   _               = False++---------------------------------------------------------+--  Selected RDFLabel values+---------------------------------------------------------++res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil,+  res_rdfs_member, res_rdfd_GeneralRestriction,+  res_rdfd_onProperties, res_rdfd_constraint,+  res_rdfd_maxCardinality, res_owl_sameAs, res_log_implies+  :: RDFLabel++res_rdf_type                = Res rdf_type+res_rdf_first               = Res rdf_first+res_rdf_rest                = Res rdf_rest+res_rdf_nil                 = Res rdf_nil+res_rdfs_member             = Res rdfs_member+res_rdfd_GeneralRestriction = Res rdfd_GeneralRestriction+res_rdfd_onProperties       = Res rdfd_onProperties+res_rdfd_constraint         = Res rdfd_constraint+res_rdfd_maxCardinality     = Res rdfd_maxCardinality+res_owl_sameAs              = Res owl_sameAs+res_log_implies             = Res log_implies++---------------------------------------------------------+--  Additional functions on RDFLabel values+---------------------------------------------------------++-- |Test if supplied labal is a URI resource node+isUri :: RDFLabel -> Bool+isUri (Res _) = True+isUri  _      = False++-- |Test if supplied labal is a literal node+isLiteral :: RDFLabel -> Bool+isLiteral (Lit _ _) = True+isLiteral  _        = False++-- |Test if supplied labal is an untyped literal node+isUntypedLiteral :: RDFLabel -> Bool+isUntypedLiteral (Lit _ Nothing  ) = True+isUntypedLiteral (Lit _ (Just tn)) = isLang tn+isUntypedLiteral  _                = False++-- |Test if supplied labal is an untyped literal node+isTypedLiteral :: RDFLabel -> Bool+isTypedLiteral (Lit _ (Just tn)) = not (isLang tn)+isTypedLiteral  _                = False++-- |Test if supplied labal is an XML literal node+isXMLLiteral :: RDFLabel -> Bool+isXMLLiteral = isDatatyped rdf_XMLLiteral++-- |Test if supplied label is an typed literal node of a given datatype+isDatatyped :: ScopedName -> RDFLabel -> Bool+isDatatyped d  (Lit _ (Just n)) = n == d+isDatatyped _  _                = False++-- |Test if supplied label is a container membership property+--+--  Check for namespace is RDF namespace and+--  first character of local name is '_' and+--  remaining characters of local name are all digits+isMemberProp :: RDFLabel -> Bool+isMemberProp (Res sn) = snScope sn == namespaceRDF &&+                        head loc   == '_' &&+                        all isDigit (tail loc)+                        where+                            loc = snLocal sn+isMemberProp _        = False++-- |Test if supplied labal is a blank node+isBlank :: RDFLabel -> Bool+isBlank (Blank _) = True+isBlank  _        = False++-- |Test if supplied labal is a query variable+isQueryVar :: RDFLabel -> Bool+isQueryVar (Var _) = True+isQueryVar  _      = False++-- |Extract text value from a literal node+getLiteralText :: RDFLabel -> String+getLiteralText (Lit s _) = s+getLiteralText  _        = ""++-- |Extract ScopedName value from a resource node+getScopedName :: RDFLabel -> ScopedName+getScopedName (Res sn) = sn+getScopedName  _       = nullScopedName++-- |Make a blank node from a supplied query variable,+--  or return the supplied label unchanged.+--  (Use this in when substituting an existential for an+--  unsubstituted query variable.)+makeBlank :: RDFLabel -> RDFLabel+makeBlank  (Var loc)    = Blank loc+makeBlank  lb           = lb++-- | RDF Triple (statement)++type RDFTriple = Arc RDFLabel++-- | Namespace prefix list entry++type NamespaceMap = LookupMap Namespace++data RevNamespace = RevNamespace Namespace++instance LookupEntryClass RevNamespace String String where+    keyVal   (RevNamespace (Namespace pre uri)) = (uri,pre)+    newEntry (uri,pre) = RevNamespace (Namespace pre uri)++type RevNamespaceMap = LookupMap RevNamespace++emptyNamespaceMap :: NamespaceMap+emptyNamespaceMap = LookupMap []++-- | Graph formula entry++data LookupFormula lb gr = Formula+    { formLabel :: lb+    , formGraph :: gr+    }++instance ( Eq lb, Eq gr ) => Eq (LookupFormula lb gr) where+    f1 == f2 = formLabel f1 == formLabel f2 &&+               formGraph f1 == formGraph f2++instance (Label lb)+    => LookupEntryClass (LookupFormula lb (NSGraph lb)) lb (NSGraph lb)+    where+        keyVal fe      = (formLabel fe, formGraph fe)+        newEntry (k,v) = Formula { formLabel=k, formGraph=v }++instance (Label lb) => Show (LookupFormula lb (NSGraph lb))+    where+        show (Formula l g) = show l ++ " :- { " ++ showArcs "    " g ++ " }"++type Formula lb = LookupFormula lb (NSGraph lb)++type FormulaMap lb = LookupMap (LookupFormula lb (NSGraph lb))++emptyFormulaMap :: FormulaMap RDFLabel+emptyFormulaMap = LookupMap []++{-  given up on trying to do Functor for formulae...+instance Functor (LookupFormula (NSGraph lb)) where+    fmap f fm = mapTranslateEntries (mapFormulaEntry f) fm+-}++formulaeMap :: (lb -> l2) -> FormulaMap lb -> FormulaMap l2+formulaeMap f = fmap (formulaEntryMap f) ++formulaEntryMap ::+    (lb -> l2)+    -> Formula lb+    -> Formula l2+formulaEntryMap f (Formula k gr) = Formula (f k) (fmap f gr)++formulaeMapA :: Applicative f => (lb -> f l2) -> +                FormulaMap lb -> f (FormulaMap l2)+formulaeMapA f = T.traverse (formulaEntryMapA f)++formulaEntryMapA ::+  (Applicative f) => +  (lb -> f l2)+  -> Formula lb+  -> f (Formula l2)+formulaEntryMapA f (Formula k gr) = Formula `liftA` f k <*> T.traverse f gr++{-+formulaeMapM ::+    (Monad m) => (lb -> m l2) -> FormulaMap lb -> m (FormulaMap l2)+formulaeMapM f = T.mapM (formulaEntryMapM f)++formulaEntryMapM ::+    (Monad m)+    => (lb -> m l2)+    -> Formula lb+    -> m (Formula l2)+formulaEntryMapM f (Formula k gr) =+  Formula `liftM` f k `ap` T.mapM f gr+    +-}++-- | Memory-based graph with namespaces and subgraphs++data NSGraph lb = NSGraph+    { namespaces :: NamespaceMap+    , formulae   :: FormulaMap lb+    , statements :: [Arc lb]+    }++getNamespaces :: NSGraph lb -> NamespaceMap+getNamespaces = namespaces++setNamespaces      :: NamespaceMap -> NSGraph lb -> NSGraph lb+setNamespaces ns g = g { namespaces=ns }++getFormulae :: NSGraph lb -> FormulaMap lb+getFormulae = formulae++setFormulae      :: FormulaMap lb -> NSGraph lb -> NSGraph lb+setFormulae fs g = g { formulae=fs }++getFormula     :: (Label lb) => NSGraph lb -> lb -> Maybe (NSGraph lb)+getFormula g l = mapFindMaybe l (formulae g)++setFormula     :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb+setFormula f g = g { formulae=mapReplaceOrAdd f (formulae g) }++instance (Label lb) => LDGraph NSGraph lb where+    getArcs      = statements +    setArcs as g = g { statements=as }+    containedIn = undefined -- TODO: should there be one defined?++-- Optimized method to add arc .. don't check for duplicates.+addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb+addArc ar gr = gr { statements=addSetElem ar (statements gr) }++instance Functor NSGraph where+  fmap f (NSGraph ns fml stmts) =+    NSGraph ns (formulaeMap f fml) ((map $ fmap f) stmts)++instance F.Foldable NSGraph where+  foldMap = T.foldMapDefault++instance T.Traversable NSGraph where+  traverse f (NSGraph ns fml stmts) = +    (NSGraph ns) <$> formulaeMapA f fml <*> (T.traverse $ T.traverse f) stmts+  +instance (Label lb) => Eq (NSGraph lb) where+    (==) = grEq++instance (Label lb) => Show (NSGraph lb) where+    show     = grShow ""+    showList = grShowList ""++grShowList :: (Label lb) => String -> [NSGraph lb] -> String -> String+grShowList _ []     = showString "[no graphs]"+grShowList p (g:gs) = showChar '[' . showString (grShow pp g) . showl gs+    where+        showl []     = showChar ']' -- showString $ "\n" ++ p ++ "]"+        showl (h:hs) = showString (",\n "++p++grShow pp h) . showl hs+        pp           = ' ':p++grShow   :: (Label lb) => String -> NSGraph lb -> String+grShow p g =+    "Graph, formulae: " ++ showForm ++ "\n" +++    p ++ "arcs: " ++ showArcs p g+    where+        showForm = foldr ((++) . (pp ++) . show) "" fml+        fml = listLookupMap (getFormulae g)+        pp = "\n    " ++ p++showArcs :: (Label lb) => String -> NSGraph lb -> String+showArcs p g = foldr ((++) . (pp ++) . show) "" (getArcs g)+    where+        pp = "\n    " ++ p++grEq :: (Label lb) => NSGraph lb -> NSGraph lb -> Bool+grEq g1 g2 = fst ( grMatchMap g1 g2 )++grMatchMap :: (Label lb) =>+    NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))+grMatchMap g1 g2 =+    graphMatch matchable (getArcs g1) (getArcs g2)+    where+        matchable l1 l2 = mapFormula g1 l1 == mapFormula g2 l2+        mapFormula g l  = mapFindMaybe l (getFormulae g)++toNSGraph :: (Eq lb, Show lb) => [Arc lb] -> NSGraph lb+toNSGraph arcs =+    NSGraph+        { statements = arcs+        , namespaces = emptyNamespaceMap+        , formulae   = LookupMap []+        }++-- |Merge RDF graphs, renaming blank and query variable nodes as+--  needed to neep variable nodes from the two graphs distinct in+--  the resulting graph.+merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb+merge gr1 gr2 =+    let+        bn1   = allLabels labelIsVar gr1+        bn2   = allLabels labelIsVar gr2+        dupbn = intersect bn1 bn2+        allbn = union bn1 bn2+    in+        add gr1 (remapLabels dupbn allbn id gr2)++-- |Return list of all labels (including properties) in the graph+--  satisfying a supplied filter predicate.+allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]+allLabels p gr = filter p (unionNodes p (formulaNodes p gr) (labels gr) )++-- |Return list of all subjects and objects in the graph+--  satisfying a supplied filter predicate.+allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]+allNodes p = unionNodes p [] . nodes++-- | List all nodes in graph formulae satisfying a supplied predicate+formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]+formulaNodes p gr = foldl (unionNodes p) fkeys (map (allLabels p) fvals)+    where+        -- fm :: (Label lb) => FormulaMap lb+        --                     LookupMap LookupFormula (NSGraph lb) lb+        fm    = formulae gr+        -- fvals :: (Label lb) => [NSGraph lb]+        fvals = mapVals fm+        -- fkeys :: (Label lb) => [lb]+        fkeys = filter p $ mapKeys fm++-- | Helper to filter variable nodes and merge with those found so far+unionNodes :: (Label lb) => (lb -> Bool) -> [lb] -> [lb] -> [lb]+unionNodes p ls1 ls2 = ls1 `union` filter p ls2++-- |Remap selected nodes in graph:+--+--  This is the node renaming operation that prevents graph-scoped+--  variable nodes from being merged when two graphs are merged.+remapLabels ::+    (Label lb)+    => [lb] -- ^ variable nodes to be renamed (@dupbn@)+    -> [lb] -- ^ variable nodes used that must be avoided (@allbn@)+    -> (lb -> lb) -- ^ node conversion function that is applied to nodes+    -- from @dupbn@ in the graph that are to be replaced by+    -- new blank nodes.  If no such conversion is required,+    -- supply @id@.  The function 'makeBlank' can be used to convert+    -- RDF query nodes into RDF blank nodes.+    -> NSGraph lb -- ^ graph in which nodes are to be renamed+    -> NSGraph lb+remapLabels dupbn allbn cnvbn = fmap (mapnode dupbn allbn cnvbn)++-- |Externally callable function to construct a list of (old,new)+--  values to be used for graph label remapping.+--+remapLabelList ::+    (Label lb)+    => [lb] -- ^ labels to be remaped+    -> [lb] -- ^ labels to be avoided by the remapping+    -> [(lb,lb)]+remapLabelList remap avoid = maplist remap avoid id []++-- | Remap a single graph node.+--+--  If the node is not one of those to be remapped,+--  the supplied value is returned unchanged.+mapnode ::+    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> lb -> lb+mapnode dupbn allbn cnvbn nv =+    mapFind nv nv (LookupMap (maplist dupbn allbn cnvbn []))++-- | Construct a list of (oldnode,newnode) values to be used for+--  graph label remapping.  The function operates recursiovely, adding+--  new nodes generated to the mapping list (mapbn') and also to the+--  list of nodes to be avoided (allbn').+maplist ::+    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> [(lb,lb)] -> [(lb,lb)]+maplist []         _     _     mapbn = mapbn+maplist (dn:dupbn) allbn cnvbn mapbn = maplist dupbn allbn' cnvbn mapbn'+    where+        dnmap  = newNode (cnvbn dn) allbn+        mapbn' = (dn,dnmap):mapbn+        allbn' = dnmap:allbn++-- |Given a node and a list of existing nodes, find a new node for+--  the supplied node that does not clash with any existing node.+--  (Generates an non-terminating list of possible replacements, and+--  picks the first one that isn't already in use.)+--+--  TODO: optimize this for common case @nnn@ and @_nnn@:+--    always generate @_nnn@ and keep track of last allocated+--+newNode :: (Label lb) => lb -> [lb] -> lb+newNode dn existnodes =+    head $ newNodes dn existnodes++-- |Given a node and a list of existing nodes, generate a list of new+--  nodes for the supplied node that do not clash with any existing node.+newNodes :: (Label lb) => lb -> [lb] -> [lb]+newNodes dn existnodes =+    filter (not . (`elem` existnodes)) $ trynodes (noderootindex dn)++noderootindex :: (Label lb) => lb -> (String,Int)+noderootindex dn = (nh,nx) where+    (nh,nt) = splitnodeid $ getLocal dn+    nx      = if null nt then 0 else read nt++splitnodeid :: String -> (String,String)+splitnodeid dn = splitAt (tx+1) dn where+    tx = last $ (-1):findIndices (not . isDigit) dn++trynodes :: (Label lb) => (String,Int) -> [lb]+trynodes (nr,nx) = [ makeLabel (nr++show n) | n <- iterate (+1) nx ]++{-+trybnodes :: (Label lb) => (String,Int) -> [lb]+trybnodes (nr,nx) = [ makeLabel (nr++show n) | n <- iterate (+1) nx ]+-}++-- | Memory-based RDF graph type++type RDFGraph = NSGraph RDFLabel++-- |Create a new RDF graph from a supplied list of arcs+toRDFGraph :: [Arc RDFLabel] -> RDFGraph+toRDFGraph = toNSGraph ++-- |Create a new, empty RDF graph.+emptyRDFGraph :: RDFGraph+emptyRDFGraph = toRDFGraph []++{-+-- |Update an RDF graph using a supplied list of arcs, keeping+--  prefix definitions and formula definitions from the original.+--+--  [[[TODO:  I think this may be redundant - the default graph+--  class has an update method which accepts a function to update+--  the arcs, not touching other parts of the graph value.]]]+updateRDFGraph :: RDFGraph -> [Arc RDFLabel] -> RDFGraph+updateRDFGraph gr as = gr { statements=as }+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFGraphShowM.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TypeSynonymInstances #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFGraphShowM+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  TypeSynonymInstances+--+--  This module defines a `ShowM` class instance for `RDFGraph`, to be+--  used when displaying RDF Graph values as part of a proof sequence,+--  etc.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFGraphShowM()+where++import Swish.RDF.RDFGraph+    ( RDFGraph )++import Swish.RDF.N3Formatter+    ( formatGraphIndent )++import Swish.Utils.ShowM+    ( ShowM(..) )+++------------------------------------------------------------+--  ShowM instance for RDFGraph+------------------------------------------------------------++instance ShowM RDFGraph where+    showms linebreak = formatGraphIndent linebreak False +++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFParser.hs view
@@ -0,0 +1,214 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFParser+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  Support for the RDF Parsing modules.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFParser+    ( SpecialMap+    , mapPrefix+              +    -- tables+    , prefixTable, specialTable++    -- parser+    , ParseResult, RDFParser+    , n3Style, n3Lexer+    , ignore+    , annotateParsecError+    , mkTypedLit+    )+where++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , NamespaceMap+    )++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , mapFind +    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , namespaceOWL+    , namespaceLOG+    , rdf_type+    , rdf_first, rdf_rest, rdf_nil+    , owl_sameAs, log_implies+    , default_base+    )++import Control.Applicative+import Control.Monad (MonadPlus(..), ap)++import Text.ParserCombinators.Parsec (GenParser, ParseError, char, letter, alphaNum, errorPos, sourceLine, sourceColumn)+import Text.ParserCombinators.Parsec.Error (errorMessages, showErrorMessages)+import Text.ParserCombinators.Parsec.Language (emptyDef)+import qualified Text.ParserCombinators.Parsec.Token as P++import Data.Maybe (fromMaybe)++-- Code++{-|+The language definition for N3-style formats.+-}++n3Style :: P.LanguageDef st+n3Style =+        emptyDef+            { P.commentStart   = ""+            , P.commentEnd     = ""+            , P.commentLine    = "#"+            , P.nestedComments = True+            , P.identStart     = letter <|> char '_'      -- oneOf "_"+            , P.identLetter    = alphaNum <|> char '_'+            , P.reservedNames  = []+            , P.reservedOpNames= []+            , P.caseSensitive  = True+            }++{-|+The lexer for N3 style languages.+-}+n3Lexer :: P.TokenParser st+n3Lexer = P.makeTokenParser n3Style++-- | Type for special name lookup table+type SpecialMap = LookupMap (String,ScopedName)++-- | Lookup prefix in table and return URI or 'prefix:'+mapPrefix :: NamespaceMap -> String -> String+mapPrefix ps pre = mapFind (pre++":") pre ps++-- | Define default table of namespaces+prefixTable :: [Namespace]+prefixTable =   [ namespaceRDF+                , namespaceRDFS+                , namespaceRDFD     -- datatypes+                , namespaceOWL+                , namespaceLOG+                , Namespace "" "#" -- is this correct?+                ]++{-|+Define default special-URI table.+The optional argument defines the initial base URI.+-}+specialTable :: Maybe ScopedName -> [(String,ScopedName)]+specialTable mbase =+  [ ("a",         rdf_type    ),+    ("equals",    owl_sameAs  ),+    ("implies",   log_implies ),+    ("listfirst", rdf_first   ),+    ("listrest",  rdf_rest    ),+    ("listnull",  rdf_nil     ),+    ("base",      fromMaybe default_base mbase ) +  ]++----------------------------------------------------------------------+--  Define top-level parser function:+--  accepts a string and returns a graph or error+----------------------------------------------------------------------++type RDFParser a b = GenParser Char a b++-- Applicative/Alternative are defined for us in Parsec 3+instance Applicative (GenParser a b) where+  pure = return+  (<*>) = ap+  +instance Alternative (GenParser a b) where+  empty = mzero+  (<|>) = mplus+  +type ParseResult = Either String RDFGraph++ignore :: (Monad m) => m a -> m ()+ignore p = p >> return ()++-- | Annotate a Parsec error with the local context - i.e. the actual text+-- that caused the error and preceeding/succeeding lines (if available)+--+annotateParsecError :: +    Int -- ^ the number of extra lines to include in the context (<=0 is ignored)+    -> [String] -- ^ text being parsed+    -> ParseError -- ^ the parse error+    -> String -- ^ Parsec error with additional context+annotateParsecError extraLines ls err = +    -- the following is based on the show instance of ParseError+    let ePos = errorPos err+        lNum = sourceLine ePos+        cNum = sourceColumn ePos+        -- it is possible to be at the end of the input so need+        -- to check; should produce better output than this in this+        -- case+        nLines = length ls+        ln1 = lNum - 1+        eln = max 0 extraLines+        lNums = [max 0 (ln1 - eln) .. min (nLines-1) (ln1 + eln)]+        +        beforeLines = map (ls !!) $ filter (< ln1) lNums+        afterLines  = map (ls !!) $ filter (> ln1) lNums+        +        -- in testing was able to get a line number after the text so catch this+        -- case; is it still necessary?+        errorLine = if ln1 >= nLines then "" else ls !! ln1+        arrowLine = replicate (cNum-1) ' ' ++ "^"+        finalLine = "(line " ++ show lNum ++ ", column " ++ show cNum ++ " indicated by the '^' sign above):"+        +        eHdr = "" : beforeLines ++ errorLine : arrowLine : afterLines ++ [finalLine]+        eMsg = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input"+               (errorMessages err)++    in unlines eHdr ++ eMsg++-- | Create a typed literal.+mkTypedLit ::+  ScopedName -- ^ the type+  -> String -- ^ the value+  -> RDFLabel+mkTypedLit u v = Lit v (Just u)++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFProof.hs view
@@ -0,0 +1,381 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFProof+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  FlexibleInstances, UndecidableInstances+--+--  This module instantiates the 'Proof' framework for+--  constructing proofs over RDFGraph expressions.+--  The intent is that this can be used to test some+--  correspondences between the RDF Model theory and+--  corresponding proof theory based on closure rules+--  applied to the graph, per <http://www.w3.org/TR/rdf-mt/>.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFProof+    ( RDFProof, RDFProofStep+    , makeRDFProof, makeRDFProofStep+    , makeRdfInstanceEntailmentRule+    , makeRdfSubgraphEntailmentRule+    , makeRdfSimpleEntailmentRule )+where++import Swish.RDF.RDFQuery+    (  rdfQueryInstance+    , rdfQuerySubs +    )++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleset )++import Swish.RDF.RDFGraph+    ( RDFLabel(..), RDFGraph+    --, makeBlank+    , merge , allLabels , remapLabelList+    {-, newNode, newNodes+    , toRDFGraph -}, emptyRDFGraph+    )++import Swish.RDF.VarBinding+    (  makeVarBinding+    )++import Swish.RDF.Proof+    ( Proof(..), Step(..) )++import Swish.RDF.Rule+    ( Expression(..), Rule(..) )++import Swish.Utils.Namespace+    ( ScopedName(..)+    )++import Swish.RDF.GraphClass+    ( Label(..), LDGraph(..), replaceArcs )++import Swish.Utils.LookupMap+    ( makeLookupMap, mapFind )++import Swish.Utils.ListHelpers+    ( subset+    , powerSet+    , powerSequences_len+    , flist+    )++------------------------------------------------------------+--  Type instantiation of Proof framework for RDFGraph data+------------------------------------------------------------+--+--  This is a partial instantiation of the proof framework.+--  Details for applying inference rules are specific to the+--  graph instance type.++------------------------------------------------------------+--  Proof datatypes for graph values+------------------------------------------------------------++-- The following is an orphan instance++-- |Instances of 'LDGraph' are also instance of the+--  @Expression@ class, for which proofs can be constructed.+--  The empty RDF graph is always @True@ (other enduring+--  truths are asserted as axioms).+instance (Label lb, LDGraph lg lb) => Expression (lg lb) where+    isValid gr = null $ getArcs gr++------------------------------------------------------------+--  Define RDF-specific types for proof framework+------------------------------------------------------------++type RDFProof     = Proof RDFGraph++type RDFProofStep = Step RDFGraph++------------------------------------------------------------+--  Helper functions for constructing proofs on RDF graphs+------------------------------------------------------------++-- |Make an RDF graph proof step+--+makeRDFProofStep ::+    RDFRule  -- ^ rule to use for this step+    -> [RDFFormula] -- ^ antecedent RDF formulae for this step+    -> RDFFormula -- ^ RDF formula that is the consequent for this step +    -> RDFProofStep+makeRDFProofStep rul ants con = Step+    { stepRule = rul+    , stepAnt  = ants+    , stepCon  = con+    }++-- |Make an RDF proof+--+makeRDFProof ::+    [RDFRuleset]      -- ^ RDF rulesets that constitute a proof context for this proof+    -> RDFFormula     -- ^ initial statement from which the goal is claimed to be proven+    -> RDFFormula     -- ^ statement that is claimed to be proven+    -> [RDFProofStep]+    -> RDFProof+makeRDFProof rsets base goal steps = Proof+    { proofContext = rsets+    , proofInput   = base+    , proofResult  = goal+    , proofChain   = steps+    }++------------------------------------------------------------+--  RDF instance entailment inference rule+------------------------------------------------------------++-- |Make an inference rule dealing with RDF instance entailment;+--  i.e. entailments that are due to replacement of a URI or literal+--  node with a blank node.+--+--  The part of this rule expected to be useful is 'checkInference'.+--  The 'fwdApply' and 'bwdApply' functions defined here may return+--  rather large results if applied to graphs with many variables or+--  a large vocabulary, and are defined for experimentation.+--+--  Forward and backward chaining is performed with respect to a+--  specified vocabulary.  In the case of backward chaining, it would+--  otherwise be impossible to bound the options thus generated.+--  In the case of forward chaining, it is often not desirable to+--  have the properties generalized.  If forward or backward backward+--  chaining will not be used, supply an empty vocabulary.+--  Note:  graph method 'allNodes' can be used to obtain a list of all+--  the subjects and objuects used ina  graph, not counting nested+--  formulae;  use a call of the form:+--+--  >  allNodes (not . labelIsVar) graph+--+makeRdfInstanceEntailmentRule :: ScopedName -> [RDFLabel] -> RDFRule+makeRdfInstanceEntailmentRule name vocab = newrule+    where+        newrule = Rule+            { ruleName = name+            , fwdApply = rdfInstanceEntailFwdApply vocab+            , bwdApply = rdfInstanceEntailBwdApply vocab+            , checkInference = rdfInstanceEntailCheckInference+            }++--  Instance entailment forward chaining+--+--  Note:  unless the initial graph is small, the total result+--  here could be very large.  The existential generalizations are+--  sequenced in increasing number of substitutions applied.+--  This sequencing is determined by the powerset function used,+--  which generates subsets in increasing order of size+--  (see module 'ListHelpers').+--+--  The instances generated are all copies of the merge of the+--  supplied graphs, with some or all of the non-variable nodes+--  replaced by blank nodes.+rdfInstanceEntailFwdApply :: [RDFLabel] -> [RDFGraph] -> [RDFGraph]+rdfInstanceEntailFwdApply vocab ante =+    let+        --  Merge antecedents to single graph, renaming bnodes if needed.+        --  (Null test and using 'foldl1' to avoid merging if possible.)+        mergeGraph  = if null ante then emptyRDFGraph+                        else foldl1 merge ante+        --  Obtain lists of variable and non-variable nodes+        --  (was: nonvarNodes = allLabels (not . labelIsVar) mergeGraph)+        nonvarNodes = vocab+        varNodes    = allLabels labelIsVar mergeGraph+        --  Obtain list of possible remappings for non-variable nodes+        mapList     = remapLabelList nonvarNodes varNodes+        mapSubLists = powerSet mapList+        mapGr ls = fmap (\l -> mapFind l l (makeLookupMap ls))+    in+        --  Return all remappings of the original merged graph+        flist (map mapGr mapSubLists) mergeGraph++--  Instance entailment backward chaining (for specified vocabulary)+--+--  [[[TODO:  this is an incomplete implementation, there being no+--  provision for instantiating some variables and leaving others+--  alone.  This can be overcome in many cases by combining instance+--  and subgraph chaining.+--  Also, there is no provision for instantiating some variables in+--  a triple and leaving others alone.  This may be fixed later if+--  this function is really needed to be completely faithful to the+--  precise notion of instance entailment.]]]+rdfInstanceEntailBwdApply :: [RDFLabel] -> RDFGraph -> [[RDFGraph]]+rdfInstanceEntailBwdApply vocab cons =+    let+        --  Obtain list of variable nodes+        varNodes     = allLabels labelIsVar cons+        --  Generate a substitution for each combination of variable+        --  and vocabulary node.+        varBindings  = map (makeVarBinding . zip varNodes) vocSequences+        vocSequences = powerSequences_len (length varNodes) vocab+    in+        --  Generate a substitution for each combination of variable+        --  and vocabulary:+        [ rdfQuerySubs [v] cons | v <- varBindings ]++--  Instance entailment inference checker+rdfInstanceEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool+rdfInstanceEntailCheckInference ante cons =+    let+        mante = if null ante then emptyRDFGraph -- merged antecedents+                    else foldl1 merge ante+        qvars = rdfQueryInstance cons mante     -- all query matches+        bsubs = rdfQuerySubs qvars cons         -- all back substitutions+    in+        --  Return True if any back-substitution matches the original+        --  merged antecendent graph.+        any (mante ==) bsubs++--  Instance entailment notes.+--+--  Relation to simple entailment (s-entails):+--+--  (1) back-substitution yields original graph+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o1  by [_:o1/ex:o1]+--+--  (2) back-substitution yields original graph+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]+--  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/_:o1]+--+--  (3) back-substitution does not yield original graph+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]+--  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/ex:o1]+--+--  (4) consider+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 ex:o1+--  ex:s1 ex:p1 ex:o2             ex:s1 ex:p1 ex:o2+--  ex:s1 ex:p1 ex:o3             ex:s1 ex:p1 _:o1+--                                ex:s1 ex:p1 _:o2+--  where [_:o1/ex:o1,_:o2/ex:o2] yields a simple entailment but not+--  an instance entailment, but [_:o1/ex:o3,_:o2/ex:o3] is also+--  (arguably) an instance entailment.  Therefore, it is not sufficient+--  to look only at the "largest" substitutions to determine instance+--  entailment.+--+--  All this means that when checking for instance entailment by+--  back substitution, all of the query results must be checked.+--  This seems clumsy.  If this function is heavily used with+--  multiple query matches, a modified query that uses each+--  triple of the target graph exactly once may be required.++------------------------------------------------------------+--  RDF subgraph entailment inference rule+------------------------------------------------------------++-- |Make an inference rule dealing with RDF subgraph entailment.+--  The part of this rule expected to be useful is 'checkInference'.+--  The 'fwdApply' function defined here may return rather large+--  results.  But in the name of completeness and experimentation+--  with the possibilities of lazy evaluation, it has been defined.+--+--  Backward chaining is not performed, as there is no reasonable way+--  to choose a meaningful supergraph of that supplied.+makeRdfSubgraphEntailmentRule :: ScopedName -> RDFRule+makeRdfSubgraphEntailmentRule name = newrule+    where+        newrule = Rule+            { ruleName = name+            , fwdApply = rdfSubgraphEntailFwdApply+            , bwdApply = const []+            , checkInference = rdfSubgraphEntailCheckInference+            }++--  Subgraph entailment forward chaining+--+--  Note:  unless the initial graph is small, the total result+--  here could be very large.  The subgraphs are sequenced in+--  increasing size of the sub graph.  This sequencing is determined+--  by the 'powerSet' function used which generates subsets in+--  increasing order of size (see module 'ListHelpers').+rdfSubgraphEntailFwdApply :: [RDFGraph] -> [RDFGraph]+rdfSubgraphEntailFwdApply ante =+    let+        --  Merge antecedents to single graph, renaming bnodes if needed.+        --  (Null test and using 'foldl1' to avoid merging if possible.)+        mergeGraph  = if null ante then emptyRDFGraph+                        else foldl1 merge ante+    in+        --  Return all subgraphs of the full graph constructed above+        map (replaceArcs mergeGraph) (init $ powerSet $ getArcs mergeGraph)++--  Subgraph entailment inference checker+--+--  This is of dubious utiltiy, as it doesn't allow for node renaming.+--  The simple entailment inference rule is probably more useful here.+rdfSubgraphEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool+rdfSubgraphEntailCheckInference ante cons =+    let+        --  Combine antecedents to single graph, renaming bnodes if needed.+        --  (Null test and using 'foldl1' to avoid merging if possible.)+        fullGraph  = if null ante then emptyRDFGraph+                        else foldl1 add ante+    in+        --  Check each consequent graph arc is in the antecedent graph+        getArcs cons `subset` getArcs fullGraph++------------------------------------------------------------+--  RDF simple entailment inference rule+------------------------------------------------------------++-- |Make an inference rule dealing with RDF simple entailment.+--  The part of this rule expected to be useful is 'checkInference'.+--  The 'fwdApply' and 'bwdApply' functions defined return null+--  results, indicating that they are not useful for the purposes+--  of proof discovery.+makeRdfSimpleEntailmentRule :: ScopedName -> RDFRule+makeRdfSimpleEntailmentRule name = newrule+    where+        newrule = Rule+            { ruleName = name+            , fwdApply = const []+            , bwdApply = const []+            , checkInference = rdfSimpleEntailCheckInference+            }++--  Simple entailment inference checker+--+--  Note:  antecedents here are presumed to share bnodes.+--         (Use 'merge' instead of 'add' for non-shared bnodes)+--+rdfSimpleEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool+rdfSimpleEntailCheckInference ante cons =+    let agr = if null ante then emptyRDFGraph else foldl1 add ante+    in+        not $ null $ rdfQueryInstance cons agr++{- original..+        not $ null $ rdfQueryInstance cons (foldl1 merge ante)+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFProofContext.hs view
@@ -0,0 +1,859 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFProofContext+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains proof-context declarations based on+--  the RDF, RDFS and RDF datatyping semantics specifications.+--  These definitions consist of namespaces (for identification+--  in proofs), axioms and inference rules.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFProofContext+    ( rulesetRDF+    , rulesetRDFS+    , rulesetRDFD )+where++import Swish.RDF.BuiltInDatatypes+    ( findRDFDatatype )++import Swish.RDF.RDFProof+    ( makeRdfSubgraphEntailmentRule+    , makeRdfSimpleEntailmentRule )++import Swish.RDF.RDFRuleset +    ( RDFFormula, RDFRule, RDFRuleset +    , makeRDFFormula+    , makeN3ClosureRule+    , makeN3ClosureSimpleRule+    , makeN3ClosureModifyRule+    , makeN3ClosureAllocatorRule+    , makeNodeAllocTo )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding+    , RDFVarBindingModify+    , RDFVarBindingFilter+    , rdfVarBindingUriRef, rdfVarBindingBlank+    , rdfVarBindingLiteral+    , rdfVarBindingUntypedLiteral +    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped+    , rdfVarBindingMemberProp+    )++import Swish.RDF.RDFGraph+    ( RDFLabel(..)+    , isUri, isDatatyped+    , getLiteralText )++import Swish.RDF.VarBinding+    ( applyVarBinding+    , addVarBinding+    , VarBindingModify(..)+    , makeVarFilterModify+    , varFilterDisjunction+    )++import Swish.RDF.Ruleset (makeRuleset)++import Swish.RDF.Datatype+    ( typeMkCanonicalForm )++import Swish.Utils.Namespace+    ( Namespace(..), ScopedName(..)+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , scopeRDF+    , scopeRDFS+    , scopeRDFD+    )++import Data.Maybe (isJust, fromJust)++import Control.Monad (liftM)++------------------------------------------------------------+--  Define query binding filter auxiliaries+------------------------------------------------------------++makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula scope local gr =+    makeRDFFormula scope local (prefixRDF++gr)++requireAny :: [RDFVarBindingFilter] -> RDFVarBindingFilter+requireAny = varFilterDisjunction++isLiteralV :: String -> RDFVarBindingFilter+isLiteralV = rdfVarBindingLiteral . Var++isUntypedLitV :: String -> RDFVarBindingFilter+isUntypedLitV = rdfVarBindingUntypedLiteral . Var++isXMLLitV :: String -> RDFVarBindingFilter+isXMLLitV = rdfVarBindingXMLLiteral . Var++isUriRefV :: String -> RDFVarBindingFilter+isUriRefV = rdfVarBindingUriRef . Var++isBlankV :: String -> RDFVarBindingFilter+isBlankV = rdfVarBindingBlank . Var++isDatatypedV :: String -> String -> RDFVarBindingFilter+isDatatypedV d l = rdfVarBindingDatatyped (Var d) (Var l)++isMemberPropV :: String -> RDFVarBindingFilter+isMemberPropV = rdfVarBindingMemberProp . Var++allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify+allocateTo bv av = makeNodeAllocTo (Var bv) (Var av)++--  Create new binding for datatype+valueSame :: String -> String -> String -> String -> RDFVarBindingModify+valueSame val1 typ1 val2 typ2 =+    sameDatatypedValue (Var val1) (Var typ1) (Var val2) (Var typ2)++--  Variable binding modifier to create new binding to a canonical+--  form of a datatyped literal.+sameDatatypedValue ::+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel -> RDFVarBindingModify+sameDatatypedValue val1 typ1 val2 typ2 = VarBindingModify+        { vbmName   = ScopedName namespaceRDFD "sameValue"+        , vbmApply  = sameDatatypedValueApplyAll val1 typ1 val2 typ2+        , vbmVocab  = [val1,typ1,val2,typ2]+        , vbmUsage  = [[val2]]+        }++sameDatatypedValueApplyAll ::+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel+    -> [RDFVarBinding]+    -> [RDFVarBinding]+sameDatatypedValueApplyAll val1 typ1 val2 typ2 =+    concatMap (sameDatatypedValueApply val1 typ1 val2 typ2) ++--  Auxiliary function that handles variable binding updates+--  for sameDatatypedValue+sameDatatypedValueApply ::+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel+    -> RDFVarBinding+    -> [RDFVarBinding]+sameDatatypedValueApply val1 typ1 val2 typ2 vbind =+    result+    where+        v1    = applyVarBinding vbind val1+        t1    = applyVarBinding vbind typ1+        t2    = applyVarBinding vbind typ2+        sametype = getCanonical v1 t1 t2+        result   =+            if isUri t1 && isUri t2 then+                if t1 == t2 then+                    case sametype of+                      Just st -> [addVarBinding val2 st vbind]+                      _ -> []+                else+                    error "subtype conversions not yet defined"+            else+                []++getCanonical :: RDFLabel -> RDFLabel -> RDFLabel -> Maybe RDFLabel+getCanonical v1 t1 t2 =+    if isDatatyped dqn1 v1 && isJust mdt1 then+        liftM mkLit $ typeMkCanonicalForm dt1 (getLiteralText v1)+    else+        Nothing+    where+        dqn1  = getRes t1+        dqn2  = getRes t2+        mdt1  = findRDFDatatype dqn1+        dt1   = fromJust mdt1+        mkLit st = Lit st (Just dqn2)++        getRes (Res dqnam) = dqnam+        getRes x = error $ "Expected a Resource, sent " ++ show x -- for -Wall++{- -- Test data+qnamint = ScopedName namespaceXSD "integer"+xsdint  = Res qnamint+lab010  = Lit "010" (Just qnamint)+can010  = getCanonical lab010 xsdint xsdint+nsex    = Namespace "ex" "http://example.org/"+resexp  = Res (ScopedName nsex "p")+resexs  = Res (ScopedName nsex "s")++vara = Var "a"+varb = Var "b"+varc = Var "c"+vard = Var "d"+varp = Var "p"+vars = Var "s"+vart = Var "t"++vb1  = makeVarBinding [(vara,lab010),(varb,xsdint),(vard,xsdint)]+vb2  = sameDatatypedValueApply vara varb varc vard vb1+vb3  = vbmApply (sameDatatypedValue vara varb varc vard) [vb1]+vb3t = vb3 == vb2+vb4  = vbmApply (valueSame "a" "b" "c" "d") [vb1]+vb4t = vb4 == vb2+vb5  = vbmApply (valueSame "a" "b" "c" "b") [vb1]+vb5t = vb5 == vb2++vb6  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)]+vb7  = vbmApply (valueSame "s" "d" "t" "d") [vb6]+vb8  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)+                      ,(vart,fromJust can010)]+vb8t = vb7 == [vb8]+-- -}++------------------------------------------------------------+--  Common definitions+------------------------------------------------------------++prefixRDF :: String+prefixRDF =+    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" +++    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" +++    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" +++    " \n"++------------------------------------------------------------+--  Define RDF axioms+------------------------------------------------------------++-- scopeRDF  = Namespace "rs-rdf"  "http://id.ninebynine.org/2003/Ruleset/rdf#"++--  RDF axioms (from RDF semantics document, section 3.1)+--+--  (See also, container property rules below)+--+rdfa1 :: RDFFormula+rdfa1 = makeFormula scopeRDF "a1" "rdf:type      rdf:type rdf:Property ."++rdfa2 :: RDFFormula+rdfa2 = makeFormula scopeRDF "a2" "rdf:subject   rdf:type rdf:Property ."++rdfa3 :: RDFFormula+rdfa3 = makeFormula scopeRDF "a3" "rdf:predicate rdf:type rdf:Property ."++rdfa4 :: RDFFormula+rdfa4 = makeFormula scopeRDF "a4" "rdf:object    rdf:type rdf:Property ."++rdfa5 :: RDFFormula+rdfa5 = makeFormula scopeRDF "a5" "rdf:first     rdf:type rdf:Property ."++rdfa6 :: RDFFormula+rdfa6 = makeFormula scopeRDF "a6" "rdf:rest      rdf:type rdf:Property ."++rdfa7 :: RDFFormula+rdfa7 = makeFormula scopeRDF "a7" "rdf:value     rdf:type rdf:Property ."++rdfa8 :: RDFFormula+rdfa8 = makeFormula scopeRDF "a8" "rdf:nil       rdf:type rdf:List ."++axiomsRDF :: [RDFFormula]+axiomsRDF =+    [ rdfa1,  rdfa2,  rdfa3,  rdfa4,  rdfa5+    , rdfa6,  rdfa7,  rdfa8+    ]++------------------------------------------------------------+--  Define RDF rules+------------------------------------------------------------++--  RDF subgraph entailment (from RDF semantics document section 2)+--+rdfsub :: RDFRule +rdfsub = makeRdfSubgraphEntailmentRule (ScopedName scopeRDF "sub")++--  RDF simple entailment (from RDF semantics document section 7.1)+--  (Note: rules se1 and se2 are combined here, because the scope of+--  the "allocatedTo" modifier is the application of a single rule.)+--+rdfse :: RDFRule+rdfse = makeRdfSimpleEntailmentRule (ScopedName scopeRDF "se")++--  RDF bnode-for-literal assignments (from RDF semantics document section 7.1)+--+rdflg :: RDFRule+rdflg = makeN3ClosureAllocatorRule scopeRDF "lg"+            "?x  ?a ?l . "+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."+            (makeVarFilterModify $ isLiteralV "l")+            (allocateTo "b" "l")++--  RDF bnode-for-literal back-tracking (from RDF semantics document section 7.1)+--+rdfgl :: RDFRule+rdfgl = makeN3ClosureSimpleRule scopeRDF "gl"+            "?x  ?a ?l . ?b rdf:_allocatedTo ?l . "+            "?x  ?a ?b ."++--  RDF entailment rules (from RDF semantics document section 7.2)+--+--  (Note, statements with property rdf:_allocatedTo are introduced to+--  track bnodes introduced according to rule rdflf.)+--+rdfr1 :: RDFRule+rdfr1 = makeN3ClosureSimpleRule scopeRDF "r1"+            "?x ?a ?y ."+            "?a rdf:type rdf:Property ."++rdfr2 :: RDFRule+rdfr2 = makeN3ClosureRule scopeRDF "r2"+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "+            "?b rdf:type rdf:XMLLiteral ."+            (makeVarFilterModify $ isXMLLitV "l")++--  Container property axioms (from RDF semantics document section 3.1)+--+--  (Using here an inference rule with a filter in place of an axiom schema)+--+--  This is a restricted form of the given axioms, in that the axioms+--  are asserted only for container membership terms that appear in+--  the graph.+--+--  (This may be very inefficient for forward chaining when dealing with+--  large graphs:  may need to look at query logic to see if the search for+--  container membership properties can be optimized.  This may call for a+--  custom inference rule.)+--+rdfcp1 :: RDFRule+rdfcp1 = makeN3ClosureRule scopeRDF "cp1"+            "?x  ?c ?y . "+            "?c rdf:type rdf:Property ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfcp2 :: RDFRule+rdfcp2 = makeN3ClosureRule scopeRDF "cp2"+            "?c  ?p ?y . "+            "?c rdf:type rdf:Property ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfcp3 :: RDFRule+rdfcp3 = makeN3ClosureRule scopeRDF "cp3"+            "?x  ?p ?c . "+            "?c rdf:type rdf:Property ."+            (makeVarFilterModify $ isMemberPropV "c")++--  Collect RDF rules+--+rulesRDF :: [RDFRule]+rulesRDF =+    [ rdfsub,     rdfse+    , rdflg,      rdfgl+    , rdfr1,      rdfr2+    , rdfcp1,     rdfcp2,     rdfcp3+    ]++--  Define ruleset for RDF inference++rulesetRDF :: RDFRuleset+rulesetRDF = makeRuleset scopeRDF axiomsRDF rulesRDF++------------------------------------------------------------+--  Define RDFS axioms+------------------------------------------------------------++-- scopeRDFS = Namespace "rdfs" "http://id.ninebynine.org/2003/Ruleset/rdfs#"++--  RDFS axioms (from RDF semantics document, section 4.1)+--+--  (See also, container property rules below)+--++rdfsa01 :: RDFFormula+rdfsa01 = makeFormula scopeRDFS "a01"+    "rdf:type           rdfs:domain rdfs:Resource ."++rdfsa02 :: RDFFormula+rdfsa02 = makeFormula scopeRDFS "a02"+    "rdf:type           rdfs:range  rdfs:Class ."++rdfsa03 :: RDFFormula+rdfsa03 = makeFormula scopeRDFS "a03"+    "rdfs:domain        rdfs:domain rdf:Property ."++rdfsa04 :: RDFFormula+rdfsa04 = makeFormula scopeRDFS "a04"+    "rdfs:domain        rdfs:range  rdfs:Class ."++rdfsa05 :: RDFFormula+rdfsa05 = makeFormula scopeRDFS "a05"+    "rdfs:range         rdfs:domain rdf:Property ."++rdfsa06 :: RDFFormula+rdfsa06 = makeFormula scopeRDFS "a06"+    "rdfs:range         rdfs:range  rdfs:Class ."++rdfsa07 :: RDFFormula+rdfsa07 = makeFormula scopeRDFS "a07"+    "rdfs:subPropertyOf rdfs:domain rdf:Property ."++rdfsa08 :: RDFFormula+rdfsa08 = makeFormula scopeRDFS "a08"+    "rdfs:subPropertyOf rdfs:range  rdf:Property ."++rdfsa09 :: RDFFormula+rdfsa09 = makeFormula scopeRDFS "a09"+    "rdfs:subClassOf    rdfs:domain rdfs:Class ."++rdfsa10 :: RDFFormula+rdfsa10 = makeFormula scopeRDFS "a10"+    "rdfs:subClassOf    rdfs:range  rdfs:Class ."++rdfsa11 :: RDFFormula+rdfsa11 = makeFormula scopeRDFS "a11"+    "rdf:subject        rdfs:domain rdf:Statement ."++rdfsa12 :: RDFFormula+rdfsa12 = makeFormula scopeRDFS "a12"+    "rdf:subject        rdfs:range  rdfs:Resource ."++rdfsa13 :: RDFFormula+rdfsa13 = makeFormula scopeRDFS "a13"+    "rdf:predicate      rdfs:domain rdf:Statement ."++rdfsa14 :: RDFFormula+rdfsa14 = makeFormula scopeRDFS "a14"+    "rdf:predicate      rdfs:range  rdfs:Resource ."++rdfsa15 :: RDFFormula+rdfsa15 = makeFormula scopeRDFS "a15"+    "rdf:object         rdfs:domain rdf:Statement ."++rdfsa16 :: RDFFormula+rdfsa16 = makeFormula scopeRDFS "a16"+    "rdf:object         rdfs:range  rdfs:Resource ."++rdfsa17 :: RDFFormula+rdfsa17 = makeFormula scopeRDFS "a17"+    "rdfs:member        rdfs:domain rdfs:Resource ."++rdfsa18 :: RDFFormula+rdfsa18 = makeFormula scopeRDFS "a18"+    "rdfs:member        rdfs:range  rdfs:Resource ."++rdfsa19 :: RDFFormula+rdfsa19 = makeFormula scopeRDFS "a19"+    "rdf:first          rdfs:domain rdf:List ."++rdfsa20 :: RDFFormula+rdfsa20 = makeFormula scopeRDFS "a20"+    "rdf:first          rdfs:range  rdfs:Resource ."++rdfsa21 :: RDFFormula+rdfsa21 = makeFormula scopeRDFS "a21"+    "rdf:rest           rdfs:domain rdf:List ."++rdfsa22 :: RDFFormula+rdfsa22 = makeFormula scopeRDFS "a22"+    "rdf:rest           rdfs:range  rdf:List ."++rdfsa23 :: RDFFormula+rdfsa23 = makeFormula scopeRDFS "a23"+    "rdfs:seeAlso       rdfs:domain rdfs:Resource ."++rdfsa24 :: RDFFormula+rdfsa24 = makeFormula scopeRDFS "a24"+    "rdfs:seeAlso       rdfs:range  rdfs:Resource ."++rdfsa25 :: RDFFormula+rdfsa25 = makeFormula scopeRDFS "a25"+    "rdfs:isDefinedBy   rdfs:domain rdfs:Resource ."++rdfsa26 :: RDFFormula+rdfsa26 = makeFormula scopeRDFS "a26"+    "rdfs:isDefinedBy   rdfs:range  rdfs:Resource ."++rdfsa27 :: RDFFormula+rdfsa27 = makeFormula scopeRDFS "a27"+    "rdfs:isDefinedBy   rdfs:subPropertyOf rdfs:seeAlso ."++rdfsa28 :: RDFFormula+rdfsa28 = makeFormula scopeRDFS "a28"+    "rdfs:comment       rdfs:domain rdfs:Resource ."++rdfsa29 :: RDFFormula+rdfsa29 = makeFormula scopeRDFS "a29"+    "rdfs:comment       rdfs:range  rdfs:Literal ."++rdfsa30 :: RDFFormula+rdfsa30 = makeFormula scopeRDFS "a30"+    "rdfs:label         rdfs:domain rdfs:Resource ."++rdfsa31 :: RDFFormula+rdfsa31 = makeFormula scopeRDFS "a31"+    "rdfs:label         rdfs:range  rdfs:Literal ."++rdfsa32 :: RDFFormula+rdfsa32 = makeFormula scopeRDFS "a32"+    "rdf:value          rdfs:domain rdfs:Resource ."++rdfsa33 :: RDFFormula+rdfsa33 = makeFormula scopeRDFS "a33"+    "rdf:value          rdfs:range  rdfs:Resource ."++rdfsa34 :: RDFFormula+rdfsa34 = makeFormula scopeRDFS "a34"+    "rdf:Alt            rdfs:subClassOf    rdfs:Container ."++rdfsa35 :: RDFFormula+rdfsa35 = makeFormula scopeRDFS "a35"+    "rdf:Bag            rdfs:subClassOf    rdfs:Container ."++rdfsa36 :: RDFFormula+rdfsa36 = makeFormula scopeRDFS "a36"+    "rdf:Seq            rdfs:subClassOf    rdfs:Container ."++rdfsa37 :: RDFFormula+rdfsa37 = makeFormula scopeRDFS "a37"+    "rdfs:ContainerMembershipProperty rdfs:subClassOf rdf:Property ."++rdfsa38 :: RDFFormula+rdfsa38 = makeFormula scopeRDFS "a38"+    "rdf:XMLLiteral     rdf:type           rdfs:Datatype ."++rdfsa39 :: RDFFormula+rdfsa39 = makeFormula scopeRDFS "a39"+    "rdf:XMLLiteral     rdfs:subClassOf    rdfs:Literal ."++rdfsa40 :: RDFFormula+rdfsa40 = makeFormula scopeRDFS "a40"+    "rdfs:Datatype      rdfs:subClassOf    rdfs:Class ."++axiomsRDFS :: [RDFFormula]+axiomsRDFS =+    [          rdfsa01, rdfsa02, rdfsa03, rdfsa04+    , rdfsa05, rdfsa06, rdfsa07, rdfsa08, rdfsa09+    , rdfsa10, rdfsa11, rdfsa12, rdfsa13, rdfsa14+    , rdfsa15, rdfsa16, rdfsa17, rdfsa18, rdfsa19+    , rdfsa20, rdfsa21, rdfsa22, rdfsa23, rdfsa24+    , rdfsa25, rdfsa26, rdfsa27, rdfsa28, rdfsa29+    , rdfsa30, rdfsa31, rdfsa32, rdfsa33, rdfsa34+    , rdfsa35, rdfsa36, rdfsa37, rdfsa38, rdfsa39+    , rdfsa40+    ]++------------------------------------------------------------+--  Define RDFS rules+------------------------------------------------------------++{-+rdfr2 = makeN3ClosureRule scopeRDF "r2"+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "+            "?b rdf:type rdf:XMLLiteral ."+            (makeVarFilterModify $ isXMLLit "?l")+-}++--  RDFS entailment rules (from RDF semantics document section 7.2)+--+--  (Note, statements with property rdf:_allocatedTo are introduced to+--  track bnodes introduced according to rule rdflf.)+--+rdfsr1 :: RDFRule+rdfsr1 = makeN3ClosureRule scopeRDFS "r1"+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "+            "?b rdf:type rdfs:Literal ."+            (makeVarFilterModify $ isUntypedLitV "l" )++rdfsr2 :: RDFRule+rdfsr2 = makeN3ClosureSimpleRule scopeRDFS "r2"+            "?x ?a ?y . ?a rdfs:domain ?z ."+            "?x rdf:type ?z ."++rdfsr3 :: RDFRule+rdfsr3 = makeN3ClosureRule scopeRDFS "r3"+            "?u ?a ?v . ?a rdfs:range ?z ."+            "?v rdf:type ?z ."+            (makeVarFilterModify $ requireAny [isUriRefV "v",isBlankV "v"])++rdfsr4a :: RDFRule+rdfsr4a = makeN3ClosureSimpleRule scopeRDFS "r4a"+            "?x ?a ?y ."+            "?x rdf:type rdfs:Resource ."++rdfsr4b :: RDFRule+rdfsr4b = makeN3ClosureRule scopeRDFS "r4b"+            "?x ?a ?u ."+            "?u rdf:type rdfs:Resource ."+            (makeVarFilterModify $ requireAny [isUriRefV "u",isBlankV "u"])++rdfsr5 :: RDFRule+rdfsr5  = makeN3ClosureSimpleRule scopeRDFS "r5"+            "?a rdfs:subPropertyOf ?b . ?b rdfs:subPropertyOf ?c ."+            "?a rdfs:subPropertyOf ?c ."++rdfsr6 :: RDFRule+rdfsr6  = makeN3ClosureSimpleRule scopeRDFS "r6"+            "?x rdf:type rdf:Property ."+            "?x rdfs:subPropertyOf ?x ."++rdfsr7 :: RDFRule+rdfsr7  = makeN3ClosureSimpleRule scopeRDFS "r7"+            "?x ?a ?y . ?a rdfs:subPropertyOf ?b ."+            "?x ?b ?y ."++rdfsr8 :: RDFRule+rdfsr8  = makeN3ClosureSimpleRule scopeRDFS "r8"+            "?x rdf:type rdfs:Class ."+            "?x rdfs:subClassOf rdfs:Resource ."++rdfsr9 :: RDFRule+rdfsr9  = makeN3ClosureSimpleRule scopeRDFS "r9"+            "?x rdfs:subClassOf ?y . ?a rdf:type ?x ."+            "?a rdf:type ?y ."++rdfsr10 :: RDFRule+rdfsr10 = makeN3ClosureSimpleRule scopeRDFS "r10"+            "?x rdf:type rdfs:Class ."+            "?x rdfs:subClassOf ?x ."++rdfsr11 :: RDFRule+rdfsr11 = makeN3ClosureSimpleRule scopeRDFS "r11"+            "?x rdfs:subClassOf ?y . ?y rdfs:subClassOf ?z ."+            "?x rdfs:subClassOf ?z ."++rdfsr12 :: RDFRule+rdfsr12 = makeN3ClosureSimpleRule scopeRDFS "r12"+            "?x rdf:type rdfs:ContainerMembershipProperty ."+            "?x rdfs:subPropertyOf rdfs:member ."++rdfsr13 :: RDFRule+rdfsr13 = makeN3ClosureSimpleRule scopeRDFS "r13"+            "?x rdf:type rdfs:Datatype ."+            "?x rdfs:subClassOf rdfs:Literal ."++--  These are valid only under an extensional strengthening of RDFS,+--  discussed in section 7.3.1 of the RDF semantics specification:++{-+rdfsrext1 :: RDFRule+rdfsrext1 = makeN3ClosureSimpleRule scopeRDFS "ext1"+            "?x rdfs:domain ?y . ?y rdfs:subClassOf ?z ."+            "?x rdfs:domain ?z ."++rdfsrext2 :: RDFRule+rdfsrext2 = makeN3ClosureSimpleRule scopeRDFS "ext2"+            "?x rdfs:range ?y . ?y rdfs:subClassOf ?z ."+            "?x rdfs:range ?z ."++rdfsrext3 :: RDFRule+rdfsrext3 = makeN3ClosureSimpleRule scopeRDFS "ext3"+            "?x rdfs:domain ?y . ?z rdfs:subPropertyOf ?x ."+            "?z rdfs:domain ?y ."++rdfsrext4 :: RDFRule+rdfsrext4 = makeN3ClosureSimpleRule scopeRDFS "ext4"+            "?x rdfs:range ?y . ?z rdfs:subPropertyOf ?x ."+            "?z rdfs:range ?y ."++rdfsrext5 :: RDFRule+rdfsrext5 = makeN3ClosureSimpleRule scopeRDFS "ext5"+            "rdf:type rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."+            "rdfs:Resource rdfs:subClassOf ?y ."++rdfsrext6 :: RDFRule+rdfsrext6 = makeN3ClosureSimpleRule scopeRDFS "rext6"+            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."+            "rdfs:Class rdfs:subClassOf ?y ."++rdfsrext7 :: RDFRule+rdfsrext7 = makeN3ClosureSimpleRule scopeRDFS "rext7"+            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."+            "rdfs:Property rdfs:subClassOf ?y ."++rdfsrext8 :: RDFRule+rdfsrext8 = makeN3ClosureSimpleRule scopeRDFS "rext8"+            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."+            "rdfs:Class rdfs:subClassOf ?y ."++rdfsrext9 :: RDFRule+rdfsrext9 = makeN3ClosureSimpleRule scopeRDFS "rext9"+            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."+            "rdfs:Property rdfs:subClassOf ?y ."++-}++--  Container property axioms (from RDF semantics document section 4.1)+--+--  (Using here an inference rule with a filter in place of an axiom schema)+--+--  This is a restricted form of the given axioms, in that the axioms+--  are asserted only for container membership terms that appear in+--  the graph.+--+--  (This may be very inefficient for forward chaining when dealing with+--  large graphs:  may need to look at query logic to see if the search for+--  container membership properties can be optimized.  This may call for a+--  custom inference rule.)+--+rdfscp11 :: RDFRule+rdfscp11 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?c ?y . "+            "?c rdf:type rdfs:ContainerMembershipProperty ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp12 :: RDFRule+rdfscp12 = makeN3ClosureRule scopeRDFS "cp1"+            "?c  ?p ?y . "+            "?c rdf:type rdfs:ContainerMembershipProperty ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp13 :: RDFRule+rdfscp13 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?p ?c . "+            "?c rdf:type rdfs:ContainerMembershipProperty ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp21 :: RDFRule+rdfscp21 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?c ?y . "+            "?c rdfs:domain rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp22 :: RDFRule+rdfscp22 = makeN3ClosureRule scopeRDFS "cp1"+            "?c  ?p ?y . "+            "?c rdfs:domain rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp23 :: RDFRule+rdfscp23 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?p ?c . "+            "?c rdfs:domain rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp31 :: RDFRule+rdfscp31 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?c ?y . "+            "?c rdfs:range rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp32 :: RDFRule+rdfscp32 = makeN3ClosureRule scopeRDFS "cp1"+            "?c  ?p ?y . "+            "?c rdfs:range rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++rdfscp33 :: RDFRule+rdfscp33 = makeN3ClosureRule scopeRDFS "cp1"+            "?x  ?p ?c . "+            "?c rdfs:range rdfs:Resource ."+            (makeVarFilterModify $ isMemberPropV "c")++--  Collect RDFS rules+--+rulesRDFS :: [RDFRule]+rulesRDFS =+    [ rdfsr1,    rdfsr2,    rdfsr3,    rdfsr4a,   rdfsr4b+    , rdfsr5,    rdfsr6,    rdfsr7,    rdfsr8,    rdfsr9+    , rdfsr10,   rdfsr11,   rdfsr12,   rdfsr13+    , rdfscp11,   rdfscp12,   rdfscp13+    , rdfscp21,   rdfscp22,   rdfscp23+    , rdfscp31,   rdfscp32,   rdfscp33+    ]++--  Define ruleset for RDFS inference++rulesetRDFS :: RDFRuleset+rulesetRDFS = makeRuleset scopeRDFS axiomsRDFS rulesRDFS++------------------------------------------------------------+--  Define RDFD (datatyping) axioms+------------------------------------------------------------++-- scopeRDFD = Namespace "rdfd" "http://id.ninebynine.org/2003/Ruleset/rdfd#"++axiomsRDFD :: [RDFFormula]+axiomsRDFD =+    [+    ]++------------------------------------------------------------+--  Define RDFD (datatyping) axioms+------------------------------------------------------------++--  RDFD closure rules from semantics document, section 7.4++--  Infer type of datatyped literal+--+rdfdr1 :: RDFRule+rdfdr1 = makeN3ClosureRule scopeRDFD "r1"+            "?d rdf:type rdfs:Datatype . ?a ?p ?l . ?b rdf:_allocatedTo ?l . "+            "?b rdf:type ?d ."+            (makeVarFilterModify $ isDatatypedV "d" "l")++--  Equivalent literals with same datatype:+--  (generate canonical form, or operate in proof mode only)+--+rdfdr2 :: RDFRule+rdfdr2 = makeN3ClosureRule scopeRDFD "r2"+            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."+            "?a ?p ?t ."+            (valueSame "s" "d" "t" "d")++{- Note that valueSame does datatype check.  Otherwise use:+rdfdr2 = makeN3ClosureModifyRule scopeRDFD "r2"+            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."+            "?a ?p ?t ."+            (makeVarFilterModify $ isDatatypedV "d" "s")+            (valueSame "s" "d" "t" "d")+-}++--  Equivalent literals with different datatypes:+--  (generate canonical form, or operate in proof mode only)+--+rdfdr3 :: RDFRule+rdfdr3 = makeN3ClosureModifyRule scopeRDFD "r3"+            ( "?d rdf:type rdfs:Datatype . ?e rdf:type rdfs:Datatype . " +++              "?a ?p ?s ." )+            "?a ?p ?t ."+            (makeVarFilterModify $ isDatatypedV "s" "d")+            (valueSame "s" "d" "t" "e")++--  Collect RDFD rules+--+rulesRDFD :: [RDFRule]+rulesRDFD =+    [ rdfdr1, rdfdr2, rdfdr3+    ]++--  Define ruleset for RDFD inference+--+rulesetRDFD :: RDFRuleset+rulesetRDFD = makeRuleset scopeRDFD axiomsRDFD rulesRDFD++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFQuery.hs view
@@ -0,0 +1,619 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFQuery+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines functions for querying an RDF graph to obtain+--  a set of variable substitutions, and to apply a set of variable+--  substitutions to a query pattern to obtain a new graph.+--+--  It also defines a few primitive graph access functions.+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFQuery+    ( rdfQueryFind, rdfQueryFilter+    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify+    , rdfQueryInstance+    , rdfQuerySubs, rdfQueryBackSubs+    , rdfQuerySubsAll+    , rdfQuerySubsBlank, rdfQueryBackSubsBlank+    , rdfFindArcs, rdfSubjEq, rdfPredEq, rdfObjEq+    , rdfFindPredVal, rdfFindPredInt, rdfFindValSubj+    , rdfFindList+    -- debug+    , rdfQuerySubs2 )+where++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding, nullRDFVarBinding+    , RDFVarBindingFilter+    )++import Swish.RDF.RDFGraph+    ( Arc(..), LDGraph(..)+    , arcSubj, arcPred, arcObj+    , RDFLabel(..)+    , isDatatyped, isBlank, isQueryVar+    , getLiteralText, makeBlank+    , RDFTriple+    , RDFGraph, emptyRDFGraph+    , allLabels, remapLabels+    , res_rdf_first+    , res_rdf_rest+    , res_rdf_nil+    )++import Swish.RDF.MapXsdInteger+    ( mapXsdInteger+    )++import Swish.RDF.Datatype+    ( DatatypeMap(..)+    )++import Swish.RDF.VarBinding+    ( VarBinding(..)+    , makeVarBinding+    , applyVarBinding, joinVarBindings+    , VarBindingModify(..)+    , VarBindingFilter(..)+    )++import Swish.RDF.Vocabulary+    ( xsd_integer, xsd_nonneg_integer+    )++import Swish.Utils.ListHelpers+    ( listProduct, allp, anyp )++import qualified Data.Traversable as T++import Control.Monad.State+    ( State, runState, modify )++import Data.Maybe+    ( mapMaybe, isJust, fromJust )++------------------------------------------------------------+--  Primitive RDF graph queries+------------------------------------------------------------++-- |Basic graph-query function.+--+--  A very basic form of graph query, a query graph and+--  a target graph, and returns a list of 'RDFVarBinding'+--  values, each of which corresponds to a set of variable+--  bindings that make the query graph a subgraph of the+--  target graph, or @[]@ if the query cannot be matched.+--+--  The triples of the query graph are matched sequentially+--  against the target graph, each taking account of any+--  variable bindings that have already been determined,+--  and adding new variable bindings as triples containing+--  query variables are matched against the graph.+--+rdfQueryFind :: RDFGraph -> RDFGraph -> [RDFVarBinding]+rdfQueryFind =+    rdfQueryPrim1 matchQueryVariable nullRDFVarBinding . getArcs++--  Helper function to match query against a graph.+--  A node-query function is supplied to determine how query nodes+--  are matched against target graph nodes.  Also supplied is+--  an initial variable binding.+--+rdfQueryPrim1 ::+    NodeQuery RDFLabel -> RDFVarBinding -> [Arc RDFLabel]+    -> RDFGraph+    -> [RDFVarBinding]+rdfQueryPrim1 _     initv []       _  = [initv]+rdfQueryPrim1 nodeq initv (qa:qas) tg =+    let+        qam  = fmap (applyVarBinding initv) qa      -- subst vars already bound+        newv = rdfQueryPrim2 nodeq qam tg           -- new bindings, or null+    in+        concat+            [ rdfQueryPrim1 nodeq v2 qas tg+            | v1 <- newv+            , let v2 = joinVarBindings initv v1+            ]++--  Match single query term against graph, and return any new sets+--  of variable bindings thus defined, or [] if the query term+--  cannot be matched.  Each of the RDFVarBinding values returned+--  represents an alternative possible match for the query arc.+--+rdfQueryPrim2 ::+    NodeQuery RDFLabel -> Arc RDFLabel+    -> RDFGraph+    -> [RDFVarBinding]+rdfQueryPrim2 nodeq qa tg =+        mapMaybe (getBinding nodeq qa) (getArcs tg)++-- |RDF query filter.+--+--  This function applies a supplied query binding+--  filter to the result from a call of 'rdfQueryFind'.+--+--  If none of the query bindings found satisfy the filter, a null+--  list is returned (which is what 'rdfQueryFind' returns if the+--  query cannot be satisfied).+--+--  (Because of lazy evaluation, this should be as efficient as+--  applying the filter as the search proceeds.  I started to build+--  the filter logic into the query function itself, with consequent+--  increase in complexity, until I remembered lazy evaluation lets+--  me keep things separate.)+--+rdfQueryFilter ::+    RDFVarBindingFilter -> [RDFVarBinding] -> [RDFVarBinding]+rdfQueryFilter qbf = filter (vbfTest qbf)++------------------------------------------------------------+--  Backward-chaining RDF graph queries+------------------------------------------------------------++-- |Reverse graph-query function.+--+--  Similar to 'rdfQueryFind', but with different success criteria.+--  The query graph is matched against the supplied graph,+--  but not every triple of the query is required to be matched.+--  Rather, every triple of the target graph must be matched,+--  and substitutions for just the variables thus bound are+--  returned.  In effect, these are subsitutions in the query+--  that entail the target graph (where @rdfQueryFind@ returns+--  substitutions that are entailed by the target graph).+--+--  Multiple substitutions may be used together, so the result+--  returned is a list of lists of query bindings.  Each inner+--  list contains several variable bindings that must all be applied+--  separately to the closure antecendents to obtain a collection of+--  expressions that together are antecedent to the supplied+--  conclusion.  A null list of bindings returned means the+--  conclusion can be inferred without any antecedents.+--+--  Note:  in back-chaining, the conditions required to prove each+--  target triple are derived independently, using the inference rule+--  for each such triple, so there are no requirements to check+--  consistency with previously determined variable bindings, as+--  there are when doing forward chaining.  A result of this is that+--  there may be redundant triples generated by the back-chaining+--  process.  Any process using back-chaining should deal with the+--  results returned accordingly.+--+--  An empty outer list is returned if no combination of+--  substitutions can infer the supplied target.+--+rdfQueryBack :: RDFGraph -> RDFGraph -> [[RDFVarBinding]]+rdfQueryBack qg tg =+    rdfQueryBack1 matchQueryVariable [] (getArcs qg) (getArcs tg)++rdfQueryBack1 ::+    NodeQuery RDFLabel -> [RDFVarBinding] -> [Arc RDFLabel] -> [Arc RDFLabel]+    -> [[RDFVarBinding]]+rdfQueryBack1 _     initv _   []       = [initv]+rdfQueryBack1 nodeq initv qas (ta:tas) = concat+    [ rdfQueryBack1 nodeq (nv:initv) qas tas+    | nv <- rdfQueryBack2 nodeq qas ta ]++--  Match a query against a single graph term, and return any new sets of+--  variable bindings thus defined.  Each member of the result is an+--  alternative possible set of variable bindings.  An empty list returned+--  means no match.+--+rdfQueryBack2 ::+    NodeQuery RDFLabel -> [Arc RDFLabel] -> Arc RDFLabel+    -> [RDFVarBinding]+rdfQueryBack2 nodeq qas ta =+    [ fromJust b | qa <- qas, let b = getBinding nodeq qa ta, isJust b ]++-- |RDF back-chaining query filter.  This function applies a supplied+--  query binding filter to the result from a call of 'rdfQueryBack'.+--+--  Each inner list contains bindings that must all be used to satisfy+--  the backchain query, so if any query binding does not satisfy the+--  filter, the entire corresponding row is removed+rdfQueryBackFilter ::+    RDFVarBindingFilter -> [[RDFVarBinding]] -> [[RDFVarBinding]]+rdfQueryBackFilter qbf = filter (all (vbfTest qbf))++-- |RDF back-chaining query modifier.  This function applies a supplied+--  query binding modifier to the result from a call of 'rdfQueryBack'.+--+--  Each inner list contains bindings that must all be used to satisfy+--  a backchaining query, so if any query binding does not satisfy the+--  filter, the entire corresponding row is removed+--+rdfQueryBackModify ::+    VarBindingModify a b -> [[VarBinding a b]] -> [[VarBinding a b]]+rdfQueryBackModify qbm = concatMap (rdfQueryBackModify1 qbm)++--  Auxiliary back-chaining query variable binding modifier function:+--  for a supplied list of variable bindings, all of which must be used+--  together when backchaining:+--  (a) make each list member into a singleton list+--  (b) apply the binding modifier to each such list, which may result+--      in a list with zero, one or more elements.+--  (c) return the listProduct of these, each member of which is+--      an alternative list of variable bindings, where the members of+--      each alternative must be used together.+--+rdfQueryBackModify1 ::+    VarBindingModify a b -> [VarBinding a b] -> [[VarBinding a b]]+rdfQueryBackModify1 qbm qbs = listProduct $ map (vbmApply qbm . (:[])) qbs++------------------------------------------------------------+--  Simple entailment graph query+------------------------------------------------------------++-- |Simple entailment (instance) graph query.+--+--  This function queries a graph to find instances of the+--  query graph in the target graph.  It is very similar+--  to the normal forward chaining query 'rdfQueryFind',+--  except that blank nodes rather than query variable nodes+--  in the query graph are matched against nodes in the target+--  graph.  Neither graph should contain query variables.+--+--  An instance is defined by the RDF semantics specification,+--  per <http://www.w3.org/TR/rdf-mt/>, and is obtained by replacing+--  blank nodes with URIs, literals or other blank nodes.  RDF+--  simple entailment can be determined in terms of instances.+--  This function looks for a subgraph of the target graph that+--  is an instance of the query graph, which is a necessary and+--  sufficient condition for RDF entailment (see the Interpolation+--  Lemma in RDF Semantics, section 1.2).+--+--  It is anticipated that this query function can be used in+--  conjunction with backward chaining to determine when the+--  search for sufficient antecendents to determine some goal+--  has been concluded.+rdfQueryInstance :: RDFGraph -> RDFGraph -> [RDFVarBinding]+rdfQueryInstance =+    rdfQueryPrim1 matchQueryBnode nullRDFVarBinding . getArcs++------------------------------------------------------------+--  Primitive RDF graph query support functions+------------------------------------------------------------++-- |Type of query node testing function.  Return value is:+--+--  * @Nothing@    if no match+--+--  * @Just True@  if match with new variable binding+--+--  * @Just False@ if match with new variable binding+--+type NodeQuery a = a -> a -> Maybe Bool++--  Extract query binding from matching a single query triple with a+--  target triple, returning:+--  - Nothing if the query is not matched+--  - Just nullVarBinding if there are no new variable bindings+--  - Just binding is a new query binding for this match+getBinding ::+    NodeQuery RDFLabel -> Arc RDFLabel -> Arc RDFLabel+    -> Maybe RDFVarBinding+getBinding nodeq (Arc s1 p1 o1) (Arc s2 p2 o2) =+    makeBinding [(s1,s2),(p1,p2),(o1,o2)] []+    where+        makeBinding [] bs = Just $ makeVarBinding bs+        makeBinding (vr@(v,r):bvrs) bs =+            case nodeq v r of+                Nothing    -> Nothing+                Just False -> makeBinding bvrs bs+                Just True  -> makeBinding bvrs (vr:bs)++--  Match variable node against target node, returning+--  Nothing if they do not match, Just True if a variable+--  node is matched (thereby creating a new variable binding)+--  or Just False if a non-blank node is matched.+matchQueryVariable :: NodeQuery RDFLabel+matchQueryVariable (Var _) _ = Just True+matchQueryVariable q t+    | q == t    = Just False+    | otherwise = Nothing++--  Match blank query node against target node, returning+--  Nothing if they do not match, Just True if a blank node+--  is matched (thereby creating a new equivalence) or+--  Just False if a non-blank node is matched.+matchQueryBnode :: NodeQuery RDFLabel+matchQueryBnode (Blank _) _ = Just True+matchQueryBnode q t+    | q == t    = Just False+    | otherwise = Nothing++------------------------------------------------------------+--  Substitute results from RDF query back into a graph+------------------------------------------------------------++-- |Graph substitution function.+--+--  Uses the supplied variable bindings to substitute variables in+--  a supplied graph, returning a list of result graphs corresponding+--  to each set of variable bindings applied to the input graph.+--  This function is used for formward chaining substitutions, and+--  returns only those result graphs for which all query variables+--  are bound.+rdfQuerySubs :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]+rdfQuerySubs vars gr =+    map fst $ filter (null . snd) $ rdfQuerySubsAll vars gr++-- |Graph back-substitution function.+--+--  Uses the supplied variable bindings from 'rdfQueryBack' to perform+--  a series of variable substitutions in a supplied graph, returning+--  a list of lists of result graphs corresponding to each set of variable+--  bindings applied to the input graphs.+--+--  The outer list of the result contains alternative antecedent lists+--  that satisfy the query goal.  Each inner list contains graphs that+--  must all be inferred to satisfy the query goal.+rdfQueryBackSubs ::+    [[RDFVarBinding]] -> RDFGraph -> [[(RDFGraph,[RDFLabel])]]+rdfQueryBackSubs varss gr = [ rdfQuerySubsAll v gr | v <- varss ]++-- |Graph substitution function.+--+--  This function performs the substitutions and returns a list of+--  result graphs each paired with a list unbound variables in each.+rdfQuerySubsAll :: [RDFVarBinding] -> RDFGraph -> [(RDFGraph,[RDFLabel])]+rdfQuerySubsAll vars gr = [ rdfQuerySubs2 v gr | v <- vars ]++-- |Graph substitution function.+--+--  This function performs each of the substitutions in 'vars', and+--  replaces any nodes corresponding to unbound query variables+--  with new blank nodes.+rdfQuerySubsBlank :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]+rdfQuerySubsBlank vars gr =+    [ remapLabels vs bs makeBlank g+    | v <- vars+    , let (g,vs) = rdfQuerySubs2 v gr+    , let bs     = allLabels isBlank g+    ]++-- |Graph back-substitution function, replacing variables with bnodes.+--+--  Uses the supplied variable bindings from 'rdfQueryBack' to perform+--  a series of variable substitutions in a supplied graph, returning+--  a list of lists of result graphs corresponding to each set of variable+--  bindings applied to the input graphs.+--+--  The outer list of the result contains alternative antecedent lists+--  that satisfy the query goal.  Each inner list contains graphs that+--  must all be inferred to satisfy the query goal.+rdfQueryBackSubsBlank :: [[RDFVarBinding]] -> RDFGraph -> [[RDFGraph]]+rdfQueryBackSubsBlank varss gr = [ rdfQuerySubsBlank v gr | v <- varss ]++--  This function applies a substitution for a single set of variable+--  bindings, returning the result and a list of unbound variables.+--  It uses a state transformer monad to collect the list of+--  unbound variables.+--+--  Adding an empty graph forces elimination of duplicate arcs.+rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel])+rdfQuerySubs2 varb gr = (add emptyRDFGraph g,vs)+    where+        (g,vs) = runState ( T.traverse (mapNode varb) gr ) []+        -- (g,vs) = runState ( fmapM (mapNode varb) gr ) []++--  Auxiliary monad function for rdfQuerySubs2.+--  This returns a state transformer Monad which in turn returns the+--  substituted node value based on the supplied query variable bindings.+--  The monad state is a list of labels which accumulates all those+--  variables seen for which no substitution was available.+mapNode :: RDFVarBinding -> RDFLabel -> State [RDFLabel] RDFLabel+mapNode varb lab =+    case vbMap varb lab of+        Just v  -> return v+        Nothing ->+            if isQueryVar lab then+                do  { modify (addVar lab)+                    ; return lab+                    }+            else+                return lab++--  Add variable to list of variables, if not already there+addVar :: RDFLabel -> [RDFLabel] -> [RDFLabel]+addVar var vars = if var `elem` vars then vars else var:vars++------------------------------------------------------------+--  Simple lightweight query primitives+------------------------------------------------------------+--+--  [[[TODO:  modify above code to use these for all graph queries]]]++-- |rdfFindArcs is the main function here:  it takes a predicate on an+--  RDF statement and a graph, and returns all statements in the graph+--  satisfying that predicate.+--+--  Use combinations of these as follows:+--+--  * find all statements with given subject:+--          @rdfQuerySimple (rdfSubjEq s)@+--+--  * find all statements with given property:+--          @rdfQuerySimple (rdfPredEq p)@+--+--  * find all statements with given object:+--          @rdfQuerySimple (rdfObjEq  o)@+--+--  * find all statements matching conjunction of these conditions:+--          @rdfQuerySimple ('allp' [...])@+--+--  * find all statements matching disjunction of these conditions:+--          @rdfQuerySimple ('anyp' [...])@+--+--  Custom predicates can also be used.+--+rdfFindArcs :: (RDFTriple -> Bool) -> RDFGraph -> [RDFTriple]+rdfFindArcs p = filter p . getArcs++-- |Test if statement has given subject+rdfSubjEq :: RDFLabel -> RDFTriple -> Bool+rdfSubjEq s = (s==) . arcSubj++-- |Test if statement has given predicate+rdfPredEq :: RDFLabel -> RDFTriple -> Bool+rdfPredEq p = (p==) . arcPred++-- |Test if statement has given object+rdfObjEq  :: RDFLabel -> RDFTriple -> Bool+rdfObjEq o  = (o==) . arcObj++{-+-- |Find statements with given subject+rdfFindSubj :: RDFLabel -> RDFGraph -> [RDFTriple]+rdfFindSubj s = rdfFindArcs (rdfSubjEq s)++-- |Find statements with given predicate+rdfFindPred :: RDFLabel -> RDFGraph -> [RDFTriple]+rdfFindPred p = rdfFindArcs (rdfPredEq p)+-}++-- |Find values of given predicate for a given subject+rdfFindPredVal :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]+rdfFindPredVal s p = map arcObj . rdfFindArcs (allp [rdfSubjEq s,rdfPredEq p])++-- |Find integer values of a given predicate for a given subject+rdfFindPredInt :: RDFLabel -> RDFLabel -> RDFGraph -> [Integer]+rdfFindPredInt s p = mapMaybe getint . filter isint . pvs+    where+        pvs = rdfFindPredVal s p+        isint  = anyp+            [ isDatatyped xsd_integer+            , isDatatyped xsd_nonneg_integer+            ]+        getint = mapL2V mapXsdInteger . getLiteralText++-- |Find all subjects that have a of given value for for a given predicate+rdfFindValSubj :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]+rdfFindValSubj p o = map arcSubj . rdfFindArcs (allp [rdfPredEq p,rdfObjEq o])++------------------------------------------------------------+--  List query+------------------------------------------------------------++-- |Return a list of nodes that comprise an rdf:collection value,+--  given the head element of the collection.  If the list is+--  ill-formed then some arbitrary value is returned.+--+rdfFindList :: RDFGraph -> RDFLabel -> [RDFLabel]+rdfFindList gr hd = findhead $ rdfFindList gr findrest+    where+        findhead  = headOr (const []) $+                    map (:) (rdfFindPredVal hd res_rdf_first gr)+        findrest  = headOr res_rdf_nil (rdfFindPredVal hd res_rdf_rest gr)+        {-+        findhead  = headOr (const [])+                    [ (ob:) | Arc _ sb ob <- subgr, sb == res_rdf_first ]+        findrest  = headOr res_rdf_nil+                    [ ob | Arc _ sb ob <- subgr, sb == res_rdf_rest  ]+        subgr     = filter ((==) hd . arcSubj) $ getArcs gr+        -}+        headOr    = foldr const+        -- headOr _ (x:_) = x+        -- headOr x []    = x++------------------------------------------------------------+--  Interactive tests+------------------------------------------------------------++{-+s1 = Blank "s1"+p1 = Blank "p1"+o1 = Blank "o1"+s2 = Blank "s2"+p2 = Blank "p2"+o2 = Blank "o2"+qs1 = Var "s1"+qp1 = Var "p1"+qo1 = Var "o1"+qs2 = Var "s2"+qp2 = Var "p2"+qo2 = Var "o2"++qa1 = Arc qs1 qp1 qo1+qa2 = Arc qs2 qp2 qo2+qa3 = Arc qs2  p2 qo2+ta1 = Arc s1 p1 o1+ta2 = Arc s2 p2 o2++g1  = toRDFGraph [ta1,ta2]+g2  = toRDFGraph [qa3]++gb1  = getBinding matchQueryVariable qa1 ta1    -- ?s1=_:s1, ?p1=_:p1, ?o1=_:o1+gvs1 = qbMap (fromJust gb1) qs1                 -- _:s1+gvp1 = qbMap (fromJust gb1) qp1                 -- _:p1+gvo1 = qbMap (fromJust gb1) qo1                 -- _:o1+gvs2 = qbMap (fromJust gb1) qs2                 -- Nothing++gb3  = getBinding matchQueryVariable qa3 ta1    -- Nothing+gb4  = getBinding matchQueryVariable qa3 ta2    -- ?s2=_:s1, ?o2=_:o1++mqvs1 = matchQueryVariable qs2 s1+mqvp1 = matchQueryVariable p2  p1++--  rdfQueryFind++qfa  = rdfQueryFind g2 g1++qp2a = rdfQueryPrim2 matchQueryVariable qa3 g1+-}++{- more tests++qb1a = rdfQueryBack1 [] [qa1] [ta1,ta2]+qb1 = rdfQueryBack1 [] [qa1,qa2] [ta1,ta2]+ql1 = length qb1+qv1 = map (qb1!!0!!0) [qs1,qp1,qo1,qs2,qp2,qo2]+qv2 = map (qb1!!0!!1) [qs1,qp1,qo1,qs2,qp2,qo2]+qv3 = map (qb1!!1!!0) [qs1,qp1,qo1,qs2,qp2,qo2]+qv4 = map (qb1!!1!!1) [qs1,qp1,qo1,qs2,qp2,qo2]+qv5 = map (qb1!!2!!0) [qs1,qp1,qo1,qs2,qp2,qo2]+qv6 = map (qb1!!2!!1) [qs1,qp1,qo1,qs2,qp2,qo2]+qv7 = map (qb1!!3!!0) [qs1,qp1,qo1,qs2,qp2,qo2]+qv8 = map (qb1!!3!!1) [qs1,qp1,qo1,qs2,qp2,qo2]++qb2 = rdfQueryBack2 matchQueryVariable [qa1,qa2] ta1+ql2 = length qb2+qv1 = map (qbMap $ head qb2)        [qs1,qp1,qo1,qs2,qp2,qo2]+qv2 = map (qbMap $ head $ tail qb2) [qs1,qp1,qo1,qs2,qp2,qo2]+qb3 = rdfQueryBack2 matchQueryVariable [qa1,qa3] ta1++-}+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFRuleset.hs view
@@ -0,0 +1,535 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFRuleset+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines some datatypes and functions that are+--  used to define rules and rulesets over RDF graphs+--+--------------------------------------------------------------------------------++module Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleMap+    , RDFClosure, RDFRuleset, RDFRulesetMap+    , nullRDFFormula+    , GraphClosure(..), makeGraphClosureRule+    , makeRDFGraphFromN3String+    , makeRDFFormula+    , makeRDFClosureRule+    , makeN3ClosureRule+    , makeN3ClosureSimpleRule+    , makeN3ClosureModifyRule+    , makeN3ClosureAllocatorRule+    , makeNodeAllocTo+    -- for debugging+    , graphClosureFwdApply, graphClosureBwdApply+    )+where++import Swish.RDF.RDFQuery+    ( rdfQueryFind+    , rdfQueryBack, rdfQueryBackModify+    , rdfQuerySubs+    , rdfQuerySubsBlank+    )++import Swish.RDF.RDFGraph+    ( RDFLabel(..), RDFGraph+    , makeBlank, newNodes+    , merge, allLabels+    , toRDFGraph, emptyRDFGraph )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding, RDFVarBindingModify )++import Swish.RDF.N3Parser+    ( parseN3fromString )++import Swish.RDF.Ruleset+    ( Ruleset(..), RulesetMap+    )++import Swish.RDF.Rule+    ( Formula(..), Rule(..), RuleMap+    , fwdCheckInference+    , nullScope+    )++import Swish.RDF.VarBinding+    ( makeVarBinding+    , applyVarBinding, joinVarBindings+    , VarBindingModify(..)+    , vbmCompose+    , varBindingId+    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..) )++import Swish.RDF.Vocabulary+    ( swishName )++{-+import Swish.RDF.Proof+    ( Proof(..), Step(..) )+-}++import Swish.RDF.GraphClass+    ( Label(..), Arc(..), LDGraph(..) )++import Swish.Utils.ListHelpers+    ( equiv, flist )++import Data.List (nub)+import Data.Maybe (fromMaybe)++------------------------------------------------------------+--  Datatypes for RDF ruleset+------------------------------------------------------------++type RDFFormula     = Formula RDFGraph++type RDFRule        = Rule RDFGraph++type RDFRuleMap     = RuleMap RDFGraph++type RDFClosure     = GraphClosure RDFLabel++type RDFRuleset     = Ruleset RDFGraph++type RDFRulesetMap  = RulesetMap RDFGraph++------------------------------------------------------------+--  Declare null RDF formula+------------------------------------------------------------++nullRDFFormula :: Formula RDFGraph+nullRDFFormula = Formula+    { formName = ScopedName nullScope "nullRDFGraph"+    , formExpr = emptyRDFGraph+    }++------------------------------------------------------------+--  Datatype for graph closure rule+------------------------------------------------------------++-- |Datatype for constructing a graph closure rule+data GraphClosure lb = GraphClosure+    { nameGraphRule :: ScopedName   -- ^ Name of rule for proof display+    , ruleAnt       :: [Arc lb]     -- ^ Antecedent triples pattern+                                    --   (may include variable nodes)+    , ruleCon       :: [Arc lb]     -- ^ Consequent triples pattern+                                    --   (may include variable nodes)+    , ruleModify    :: VarBindingModify lb lb+                                    -- ^ Structure that defines additional+                                    --   constraints and/or variable+                                    --   bindings based on other matched+                                    --   query variables.  Matching the+                                    --   antecedents.  Use 'varBindingId' if+                                    --   no additional variable constraints+                                    --   or bindings are added beyond those+                                    --   arising from graph queries.+    }++instance (Label lb) => Eq (GraphClosure lb) where+    c1 == c2 = nameGraphRule c1 == nameGraphRule c2 &&+               ruleAnt c1 `equiv` ruleAnt c2 &&+               ruleCon c1 `equiv` ruleCon c2++instance (Label lb) => Show (GraphClosure lb) where+    show c = "GraphClosure " ++ show (nameGraphRule c)++------------------------------------------------------------+--  Define inference rule based on RDF graph closure rule+------------------------------------------------------------++-- |Define a value of type Rule based on an RDFClosure value.+makeGraphClosureRule :: GraphClosure RDFLabel -> Rule RDFGraph+makeGraphClosureRule grc = newrule+    where+        newrule = Rule+            { ruleName       = nameGraphRule grc+            , fwdApply       = graphClosureFwdApply grc+            , bwdApply       = graphClosureBwdApply grc+            , checkInference = fwdCheckInference newrule+            }++--  Forward chaining function based on RDF graph closure description+--+--  Note:  antecedents here are presumed to share bnodes.+--+graphClosureFwdApply :: GraphClosure RDFLabel -> [RDFGraph] -> [RDFGraph]+graphClosureFwdApply grc grs =+    let gr   = if null grs then emptyRDFGraph else foldl1 add grs+        vars = queryFind (ruleAnt grc) gr+        varm = vbmApply (ruleModify grc) vars+        cons = querySubs varm (ruleCon grc)+    in+        {-+        seq cons $+        seq (trace "\ngraphClosureFwdApply") $+        seq (traceShow "\nvars: " vars) $+        seq (traceShow "\nvarm: " varm) $+        seq (traceShow "\ncons: " cons) $+        seq (trace "\n") $+        -}+        --  Return null list or single result graph that is the union+        --  (not merge) of individual results:+        if null cons then [] else [foldl1 add cons]+        -- cons {- don't merge results -}++--  Backward chaining function based on RDF graph closure description+graphClosureBwdApply :: GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]+graphClosureBwdApply grc gr =+    let vars = rdfQueryBackModify (ruleModify grc) $+               queryBack (ruleCon grc) gr+        --  This next function eliminates duplicate variable bindings.+        --  It is strictly redundant, but comparing variable+        --  bindings is much cheaper than comparing graphs.+        --  I don't know if many duplicate graphs will be result+        --  of exact duplicate variable bindings, so this may be+        --  not very effective.+        varn = map nub vars+    in+        --  The 'nub ante' below eliminates duplicate antecedent graphs,+        --  based on graph matching, which tests for equivalence under+        --  bnode renaming, with a view to reducing redundant arcs in+        --  the merged antecedent graph, hence less to prove in+        --  subsequent back-chaining steps.+        --+        --  Each antecedent is reduced to a single RDF graph, when+        --  bwdApply specifies a list of expressions corresponding to+        --  each antecedent.+        [ [foldl1 merge (nub ante)]+          | vs <- varn+          , let ante = querySubsBlank vs (ruleAnt grc) ]++------------------------------------------------------------+--  RDF graph query and substitution support functions+------------------------------------------------------------++queryFind :: [Arc RDFLabel] -> RDFGraph -> [RDFVarBinding]+queryFind qas = rdfQueryFind (toRDFGraph qas)++queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]+queryBack qas = rdfQueryBack (toRDFGraph qas)++querySubs :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]+querySubs vars = rdfQuerySubs vars . toRDFGraph++querySubsBlank :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]+querySubsBlank vars = rdfQuerySubsBlank vars . toRDFGraph++------------------------------------------------------------+--  Method for creating an RDF formula value from N3 text+------------------------------------------------------------++-- |Helper function to parse a string containing Notation3+--  and return the corresponding RDFGraph value.+makeRDFGraphFromN3String :: String -> RDFGraph+makeRDFGraphFromN3String str = case parseN3fromString str of+    Left  msg -> error msg+    Right gr  -> gr++-- |Create an RDF formula.+makeRDFFormula ::+    Namespace+    -> String -- ^ local name+    -> String -- ^ graph in Notation 3 format+    -> RDFFormula+makeRDFFormula scope local gr = Formula+    { formName = ScopedName scope local+    , formExpr = makeRDFGraphFromN3String gr+    }++------------------------------------------------------------+--  Create an RDF closure rule from supplied graphs+------------------------------------------------------------++-- |Constructs an RDF graph closure rule.  That is, a rule that+--  given some set of antecedent statements returns new statements+--  that may be added to the graph.+--+makeRDFClosureRule ::+    ScopedName -- ^ scoped name for the new rule+    -> [RDFGraph] -- ^ RDFGraphs that are the entecedent of the rule.+                  --+                  -- (Note:  bnodes and variable names are assumed to be shared+                  -- by all the entecedent graphs supplied.  /is this right?/)+    -> RDFGraph   -- ^ the consequent graph+    -> RDFVarBindingModify -- ^ is a variable binding modifier value that may impose+    --          additional conditions on the variable bindings that+    --          can be used for this inference rule, or which may+    --          cause new values to be allocated for unbound variables.+    --          These modifiers allow for certain inference patterns+    --          that are not captured by simple "closure rules", such+    --          as the allocation of bnodes corresponding to literals,+    --          and are an extension point for incorporating datatypes+    --          into an inference process.+    --+    --          If no additional constraints or variable bindings are+    --          to be applied, use value 'varBindingId'+    --+    -> RDFRule+makeRDFClosureRule sname antgrs congr vmod = makeGraphClosureRule+    GraphClosure+        { nameGraphRule = sname+        , ruleAnt       = concatMap getArcs antgrs+        , ruleCon       = getArcs congr+        , ruleModify    = vmod+        }++------------------------------------------------------------+--  Methods to create an RDF closure rule from N3 input+------------------------------------------------------------+--+--  These functions are used internally by Swish to construct+--  rules from textual descriptions.++-- |Constructs an RDF graph closure rule.  That is, a rule that+--  given some set of antecedent statements returns new statements+--  that may be added to the graph.  This is the basis for+--  implementation of most of the inference rules given in the+--  RDF formal semantics document.+--+--  scope   is a namespace to which the rule is allocated+--  local   is a local name for the rule in the given namespace+--  ant     is a string containing +--  con     is a string containing +--+makeN3ClosureRule ::+    Namespace -- ^ namespace to which the rule is allocated+    -> String -- ^ local name for the rule in the namespace+    -> String +    -- ^ the Notation3 representation+    --   of the antecedent graph.  (Note: multiple antecedents+    --   can be handled by combining multiple graphs.)+    -> String -- ^ the Notation3 representation of the consequent graph.+    -> RDFVarBindingModify+    -- ^ a variable binding modifier value that may impose+    --   additional conditions on the variable bindings that+    --   can be used for this inference rule, or which may+    --   cause new values to be allocated for unbound variables.+    --   These modifiers allow for certain inference patterns+    --   that are not captured by simple closure rules, such+    --   as the allocation of bnodes corresponding to literals,+    --   and are an extension point for incorporating datatypes+    --   into an inference process.+    --+    --   If no additional constraints or variable bindings are+    --   to be applied, use value 'varBindingId'+    -> RDFRule+makeN3ClosureRule scope local ant con =+    makeRDFClosureRule (ScopedName scope local) [antgr] congr+    where+        antgr = makeRDFGraphFromN3String ant+        congr = makeRDFGraphFromN3String con++-- |Construct a simple RDF graph closure rule without+--  additional node allocations or variable binding constraints.+--+makeN3ClosureSimpleRule ::+    Namespace -> String -> String -> String -> RDFRule+makeN3ClosureSimpleRule scope local ant con =+    makeN3ClosureRule scope local ant con varBindingId++-- |Constructs an RDF graph closure rule that incorporates+--  a variable binding filter and a variable binding modifier.+--+makeN3ClosureModifyRule ::+    Namespace -- ^ namespace to which the rule is allocated+    -> String -- ^ local name for the rule in the given namespace+    -> String -- ^ the Notation3 representation+    --             of the antecedent graph.  (Note: multiple antecedents+    --             can be handled by combining multiple graphs.)+    -> String -- ^ the Notation3 representation of the consequent graph.+    -> RDFVarBindingModify+    -- ^ a variable binding modifier value that may impose+    --   additional conditions on the variable bindings that+    --   can be used for this inference rule (@vflt@).+    --+    --   These modifiers allow for certain inference patterns+    --   that are not captured by simple closure rules, such+    --   as deductions that pertain only to certain kinds of+    --   nodes in a graph.+    -> RDFVarBindingModify+    -- ^ a variable binding modifier that is applied to the+    --   variable bindings obtained, typically to create some+    --   additional variable bindings.  This is applied before+    --   the preceeding filter rule (@vflt@).+    -> RDFRule+makeN3ClosureModifyRule scope local ant con vflt vmod =+    makeN3ClosureRule scope local ant con modc+    where+        modc  = fromMaybe varBindingId $ vbmCompose vmod vflt++{-+    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc+    where+        antgr = makeRDFGraphFromN3String ant+        congr = makeRDFGraphFromN3String con+        modc  = case vbmCompose vmod vflt of+            Just x  -> x+            Nothing -> varBindingId+-}++-- |Construct an RDF graph closure rule with a bnode allocator.+--+--  This function is rather like 'makeN3ClosureModifyRule', except that+--  the variable binding modifier is a function from the variables in+--  the variables and bnodes contained in the antecedent graph.+--+--  scope   is a +--  local   is a +--  ant     is a string containing +--  con     is a string containing +--  vflt    is a +--  aloc    is a +--+makeN3ClosureAllocatorRule ::+    Namespace -- ^ namespace to which the rule is allocated+    -> String -- ^ local name for the rule in the given namespace+    -> String -- ^ the Notation3 representation+    --             of the antecedent graph.  (Note: multiple antecedents+    --             can be handled by combining multiple graphs.)+    -> String -- ^ the Notation3 representation of the consequent graph.+    -> RDFVarBindingModify+    -- ^ variable binding modifier value that may impose+    --   additional conditions on the variable bindings that+    --   can be used for this inference rule (@vflt@).+    -> ( [RDFLabel] -> RDFVarBindingModify )+    -- ^ function applied to a list of nodes to yield a+    --   variable binding modifier value.+    --+    --   The supplied parameter is applied to a list of all of+    --   the variable nodes (including all blank nodes) in the+    --   antecedent graph, and then composed with the @vflt@+    --   value.  This allows any node allocation+    --   function to avoid allocating any blank nodes that+    --   are already used in the antecedent graph.+    --   (See 'makeNodeAllocTo').+    -> RDFRule+makeN3ClosureAllocatorRule scope local ant con vflt aloc =+    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc+    where+        antgr = makeRDFGraphFromN3String ant+        congr = makeRDFGraphFromN3String con+        vmod  = aloc (allLabels labelIsVar antgr)+        modc  = fromMaybe varBindingId $ vbmCompose vmod vflt+++------------------------------------------------------------+--  Query binding modifier for "allocated to" logic+------------------------------------------------------------++-- |This function defines a variable binding mofifier that+--  allocates a new blank node for each value bound to+--  a query variable, and binds it to another variable+--  in each query binding.+--+--  This provides a single binding for query variables that would+--  otherwise be unbound by a query.  For example, consider the+--  inference pattern:+--        +--  >  ?a hasUncle ?c => ?a hasFather ?b . ?b hasBrother ?c .+--        +--  For a given @?a@ and @?c@, there is insufficient information+--  here to instantiate a value for variable @?b@.  Using this+--  function as part of a graph instance closure rule allows+--  forward chaining to allocate a single bnode for each+--  occurrence of @?a@, so that given:+--        +--  >  Jimmy hasUncle Fred .+--  >  Jimmy hasUncle Bob .+--+--  leads to exactly one bnode inference of:+--+--  >  Jimmy hasFather _:f .+--+--  giving:+--+--  >  Jimmy hasFather _:f .+--  >  _:f hasBrother Fred .+--  >  _:f hasBrother Bob .+--+--  rather than:+--+--  >  Jimmy hasFather _:f1 .+--  >  _:f1 hasBrother Fred .+--  >  Jimmy hasFather _:f2 .+--  >  _:f2 hasBrother Bob .+--+--  This form of constrained allocation of bnodes is also required for+--  some of the inference patterns described by the RDF formal semantics,+--  particularly those where bnodes are substituted for URIs or literals.+--+makeNodeAllocTo ::+    RDFLabel      -- ^ variable node to which a new blank node is bound+    -> RDFLabel   -- ^ variable which is bound in each query to a graph+                  --  node to which new blank nodes are allocated.+    -> [RDFLabel]+    -> RDFVarBindingModify+makeNodeAllocTo bindvar alocvar exbnode = VarBindingModify+        { vbmName   = swishName "makeNodeAllocTo"+        , vbmApply  = applyNodeAllocTo bindvar alocvar exbnode+        , vbmVocab  = [alocvar,bindvar]+        , vbmUsage  = [[bindvar]]+        }++--  Auxiliary function that performs the node allocation defined+--  by makeNodeAllocTo.+--+--  bindvar is a variable node to which a new blank node is bound+--  alocvar is a variable which is bound in each query to a graph+--          node to which new blank nodes are allocated.+--  exbnode is a list of existing blank nodes, to be avoided by+--          the new blank node allocator.+--  vars    is a list of variable bindings to which new bnode+--          allocations for the indicated bindvar are to be added.+--+applyNodeAllocTo ::+    RDFLabel -> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]+applyNodeAllocTo bindvar alocvar exbnode vars =+    let+        app       = applyVarBinding+        alocnodes = zip (nub $ flist (map app vars) alocvar)+                        (newNodes (makeBlank bindvar) exbnode)+        newvb var = joinVarBindings+            ( makeVarBinding $ head+              [ [(bindvar,b)] | (v,b) <- alocnodes, app var alocvar == v ] )+            var+    in+        map newvb vars+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/RDFVarBinding.hs view
@@ -0,0 +1,185 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFVarBinding+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module instantiates the `VarBinding` types and methods for use+--  with RDF graph labels.+--+--------------------------------------------------------------------------------++--  See module RDFQueryTest for test cases.++module Swish.RDF.RDFVarBinding+    ( RDFVarBinding, nullRDFVarBinding+    , RDFVarBindingModify, RDFOpenVarBindingModify, RDFOpenVarBindingModifyMap+    , RDFVarBindingFilter+    , rdfVarBindingUriRef, rdfVarBindingBlank+    , rdfVarBindingLiteral+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped+    , rdfVarBindingMemberProp+    )+where++import Swish.RDF.RDFGraph+    ( RDFLabel(..)+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral+    , isDatatyped, isMemberProp, isUri, isBlank+    )++import Swish.RDF.VarBinding+    ( VarBinding(..), nullVarBinding+    , applyVarBinding +    , VarBindingModify(..), OpenVarBindingModify+    , VarBindingFilter(..)+    , makeVarTestFilter+    )++import Swish.RDF.Vocabulary+    ( swishName )++import Swish.Utils.LookupMap+    ( LookupMap(..) )++------------------------------------------------------------+--  Types for RDF query variable bindings and modifiers+------------------------------------------------------------++-- |@RDFVarBinding@ is the specific type type of a variable+--  binding value used with RDF graph queries. +type RDFVarBinding  = VarBinding RDFLabel RDFLabel++-- | maps no query variables.+nullRDFVarBinding :: RDFVarBinding+nullRDFVarBinding = nullVarBinding++-- |Define type of query binding modifier for RDF graph inference+type RDFVarBindingModify = VarBindingModify RDFLabel RDFLabel++-- |Open variable binding modifier that operates on RDFLabel values+--+type RDFOpenVarBindingModify = OpenVarBindingModify RDFLabel RDFLabel++-- |Define type for lookup map of open query binding modifiers+type RDFOpenVarBindingModifyMap = LookupMap RDFOpenVarBindingModify++-- |@RDFVarBindingFilter@ is a function type that tests to see if+--  a query binding satisfies some criterion, and is used to+--  create a variable binding modifier that simply filers+--  given variable bindings.+--+--  Queries often want to apply some kind of filter or condition+--  to the variable bindings that are processed.  In inference rules,+--  it sometimes seems desirable to stipulate additional conditions on+--  the things that are matched.+--+--  This function type is used to perform such tests.+--  A number of simple implementations are included.+--+type RDFVarBindingFilter = VarBindingFilter RDFLabel RDFLabel++------------------------------------------------------------+--  Declare some query binding filters+------------------------------------------------------------++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to a URI reference.+rdfVarBindingUriRef :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingUriRef =+    makeVarTestFilter (swishName "rdfVarBindingUriRef") isUri++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to a blank node.+rdfVarBindingBlank :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingBlank =+    makeVarTestFilter (swishName "rdfVarBindingBlank") isBlank++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to a literal value.+rdfVarBindingLiteral :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingLiteral =+    makeVarTestFilter (swishName "rdfVarBindingLiteral") isLiteral++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to an untyped literal value.+rdfVarBindingUntypedLiteral :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingUntypedLiteral =+    makeVarTestFilter (swishName "rdfVarBindingUntypedLiteral") isUntypedLiteral++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to a typed literal value.+rdfVarBindingTypedLiteral :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingTypedLiteral =+    makeVarTestFilter (swishName "rdfVarBindingTypedLiteral") isTypedLiteral++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to an XML literal value.+rdfVarBindingXMLLiteral :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingXMLLiteral =+    makeVarTestFilter (swishName "rdfVarBindingXMLLiteral") isXMLLiteral++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to container membership property.+rdfVarBindingMemberProp :: RDFLabel -> RDFVarBindingFilter+rdfVarBindingMemberProp =+    makeVarTestFilter (swishName "rdfVarBindingMemberProp") isMemberProp++-- |This function generates a query binding filter that ensures+--  an indicated variable is bound to a literal value with a+--  datatype whose URI is bound to another node+--+rdfVarBindingDatatyped ::+  RDFLabel    -- ^ variable bound to the required datatype. +  -> RDFLabel -- ^ variable bound to the literal node to be tested.+  -> RDFVarBindingFilter+rdfVarBindingDatatyped dvar lvar = VarBindingFilter+    { vbfName   = swishName "rdfVarBindingDatatyped"+    , vbfVocab  = [dvar,lvar]+    , vbfTest   = \vb -> testDatatyped vb dvar lvar+    }++testDatatyped :: RDFVarBinding -> RDFLabel -> RDFLabel -> Bool+testDatatyped vb dvar lvar = and+        [ isUri dtype+        , isDatatyped dqnam $ applyVarBinding vb lvar+        ]+        where+            dtype = applyVarBinding vb dvar+            -- NOTE: dqnam is not evaluated unless (isUri dtype)+            --       but add in a _ handler to appease -Wall+            -- dqnam = case dtype of { (Res x) -> x }+            dqnam = case dtype of+              Res x -> x+              _ -> error $ "dqnam should not be evaluated with " ++ show dtype++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/Rule.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Rule+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  MultiParamTypeClasses+--+--  This module defines a framework for defining inference rules+--  over some expression form.  It is intended to be used with+--  RDF graphs, but the structures aim to be quite generic with+--  respect to the expression forms allowed.+--+--------------------------------------------------------------------------------++module Swish.RDF.Rule+    ( Expression(..), Formula(..), Rule(..), RuleMap+    , nullScope, nullFormula, nullRule+    , fwdCheckInference, bwdCheckInference+    , showsFormula, showsFormulae, showsWidth+    )+where++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    )++import Swish.Utils.ShowM+    ( ShowM(..) )++------------------------------------------------------------+--  Expressions+------------------------------------------------------------++-- |Expression is a type class for values over which proofs+--  may be constructed.+class (Eq ex) => Expression ex where+    -- |Is expression true in all interpretations?+    --  If so, then its truth is assumed without justification.+    isValid :: ex -> Bool++------------------------------------------------------------+--  Formula:  a named expression+------------------------------------------------------------++-- |A Formula is a named expression.+data Formula ex = Formula+    { formName :: ScopedName        -- ^ Name used for formula in proof chain+    , formExpr :: ex                -- ^ Named formula value+    } deriving Show++-- |Define equality of formulae as equality of formula names+instance Eq (Formula ex) where+    f1 == f2 = formName f1 == formName f2++-- |Define ordering of formulae based on formula names+instance Ord (Formula ex) where+    f1 <= f2 = formName f1 <= formName f2++instance LookupEntryClass (Formula ex) ScopedName (Formula ex)+    where+    newEntry (_,form) = form+    keyVal form = (formName form, form)++-- | The namespace @http://id.ninebynine.org/2003/Ruleset/null@+nullScope :: Namespace+nullScope = Namespace "null" "http://id.ninebynine.org/2003/Ruleset/null"++nullFormula :: Formula ex+nullFormula = Formula+    { formName = ScopedName nullScope "nullFormula"+    , formExpr = error "Null formula"+    }++-- testf1 = Formula "f1" ('f',1)+-- testf2 = Formula "f2" ('f',2)++-- |Return a displayable form of a list of labelled formulae+showsFormulae :: (ShowM ex) => String -> [Formula ex] -> String -> ShowS+showsFormulae _       []     _     = id+showsFormulae newline [f]    after = showsFormula  newline f .+                                     showString    after+showsFormulae newline (f:fs) after = showsFormula  newline f .+                                     showString    newline .+                                     showsFormulae newline fs after++-- |Create a displayable form of a labelled formula+showsFormula :: (ShowM ex) => String -> Formula ex -> ShowS+showsFormula newline f =+    showsWidth 16 ("["++show (formName f)++"] ") .+    showms (newline ++ replicate 16 ' ') (formExpr f)++------------------------------------------------------------+--  Rule+------------------------------------------------------------++-- |Rule is a data type for inference rules that can be used+--  to construct a step in a proof.+data Rule ex = Rule+    {+      -- |Name of rule, for use when displaying a proof+      ruleName :: ScopedName,+      +      -- |Forward application of a rule, takes a list of+      --  expressions and returns a list (possibly empty)+      --  of forward applications of the rule to combinations+      --  of the antecedent expressions.+      --  Note that all of the results returned can be assumed to+      --  be (simultaneously) true, given the antecedents provided.+      fwdApply :: [ex] -> [ex],+      +      -- |Backward application of a rule, takes an expression+      --  and returns a list of alternative antecedents, each of+      --  which is a list of expressions that jointly yield the+      --  given consequence through application of the inference+      --  rule.  An empty list is returned if no antecedents+      --  will allow the consequence to be inferred.+      bwdApply :: ex -> [[ex]],+      +      -- |Inference check.  Takes a list of antecedent expressions+      --  and a consequent expression, returning True if the+      --  consequence can be obtained from the antecedents by+      --  application of the rule.  When the antecedents and+      --  consequent are both given, this is generally more efficient+      --  that using either forward or backward chaining.+      --  Also, a particular rule may not fully support either+      --  forward or backward chaining, but all rules are required+      --  to fully support this function.+      --+      --  A default implementation based on forward chaining is+      --  given below.+      checkInference :: [ex] -> ex -> Bool +    }++-- |Define equality of rules as equality of rule names+instance Eq (Rule ex) where+    r1 == r2 = ruleName r1 == ruleName r2++-- |Define ordering of rules based on rule names+instance Ord (Rule ex) where+    r1 <= r2 = ruleName r1 <= ruleName r2++instance Show (Rule ex) where+    show rl = "Rule "++show (ruleName rl)++instance LookupEntryClass (Rule ex) ScopedName (Rule ex)+    where+    newEntry (_,rule) = rule+    keyVal rule = (ruleName rule, rule)++type RuleMap ex = LookupMap (Rule ex)++fwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool+fwdCheckInference rule ante cons =+    cons `elem` fwdApply rule ante++bwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool+bwdCheckInference rule ante cons = any checkAnts (bwdApply rule cons)+    where+        checkAnts = all (`elem` ante)++nullRule :: Rule ex+nullRule = Rule+    { ruleName = ScopedName nullScope "nullRule"+    , fwdApply = \ _ -> []+    , bwdApply = \ _ -> []+    , checkInference = \ _ _ -> False+    }++------------------------------------------------------------+--  Shows formatting support functions+-----------------------------------------------------------++-- |Show a string left justified in a field of at least the specified+--  number of characters width.+showsWidth :: Int -> String -> ShowS+showsWidth wid str more = str++replicate pad ' '++more+    where+        pad = wid - length str+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/Ruleset.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Ruleset+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  MultiParamTypeClasses+--+--  This module defines a ruleset data type, used to collect information+--  about a ruleset that may contribute torwards inferences in RDF;+--  e.g. RDF and RDFS are rulesets.+--+--  A ruleset consists of a namespace, a collection of axioms and+--  a collection of rules.+--+--------------------------------------------------------------------------------++module Swish.RDF.Ruleset+    ( Ruleset(..), RulesetMap+    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules+    , getRulesetAxiom, getRulesetRule+    , getContextAxiom, getMaybeContextAxiom+    , getContextRule,  getMaybeContextRule+    )+where++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.RDF.Rule+    ( Formula(..), Rule(..) )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , mapFindMaybe+    )++import Data.Maybe+    ( fromMaybe, listToMaybe, mapMaybe )++-- | Ruleset, having namespace, axioms and rules++data Ruleset ex = Ruleset+    { rsNamespace :: Namespace+    , rsAxioms    :: [Formula ex]+    , rsRules     :: [Rule ex]+    }++instance Eq (Ruleset ex) where+    r1 == r2 = rsNamespace r1 == rsNamespace r2++instance LookupEntryClass (Ruleset ex) Namespace (Ruleset ex)+    where+        keyVal   r@(Ruleset k _ _) = (k,r)+        newEntry (_,r)             = r++type RulesetMap ex = LookupMap (Ruleset ex)++makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex+makeRuleset nsp fms rls = Ruleset+    { rsNamespace = nsp+    , rsAxioms    = fms+    , rsRules     = rls+    }++getRulesetNamespace :: Ruleset ex -> Namespace+getRulesetNamespace = rsNamespace++getRulesetAxioms :: Ruleset ex -> [Formula ex]+getRulesetAxioms = rsAxioms++getRulesetRules :: Ruleset ex -> [Rule ex]+getRulesetRules = rsRules++-- | Find a named axiom or rule in a ruleset or proof context++getRulesetAxiom :: ScopedName -> Ruleset ex -> Maybe (Formula ex)+getRulesetAxiom nam rset =+    mapFindMaybe nam (LookupMap (getRulesetAxioms rset))+    -- listToMaybe $ filter ( (matchName nam) . formName ) $ getRulesetAxioms rset++getRulesetRule :: ScopedName -> Ruleset ex -> Maybe (Rule ex)+getRulesetRule nam rset =+    mapFindMaybe nam (LookupMap (getRulesetRules rset))+    -- listToMaybe $ filter ( (matchName nam) . ruleName ) $ getRulesetRules rset++getContextAxiom :: ScopedName -> Formula ex -> [Ruleset ex] -> Formula ex+getContextAxiom nam def rsets = fromMaybe def (getMaybeContextAxiom nam rsets)+    {-+    foldr (flip fromMaybe) def $ map (getRulesetAxiom nam) rsets+    -}++getMaybeContextAxiom :: ScopedName -> [Ruleset ex] -> Maybe (Formula ex)+getMaybeContextAxiom nam rsets =+    listToMaybe $ mapMaybe (getRulesetAxiom nam) rsets++getContextRule :: ScopedName -> Rule ex -> [Ruleset ex] -> Rule ex+getContextRule nam def rsets = fromMaybe def (getMaybeContextRule nam rsets)+    {-+    foldr (flip fromMaybe) def $ map (getRulesetRule nam) rsets+    -}++getMaybeContextRule :: ScopedName -> [Ruleset ex] -> Maybe (Rule ex)+getMaybeContextRule nam rsets =+    listToMaybe $ mapMaybe (getRulesetRule nam) rsets++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/SwishCommands.hs view
@@ -0,0 +1,421 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  SwishCommands+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  SwishCommands:  functions to deal with indivudual Swish command options.+--+--------------------------------------------------------------------------------++module Swish.RDF.SwishCommands+    ( swishFormat+    , swishBase+    -- , swishVerbose+    , swishInput+    , swishOutput+    , swishMerge+    , swishCompare+    , swishGraphDiff+    , swishScript+    )+where++import Swish.RDF.SwishMonad+    ( SwishStateIO, SwishState(..), SwishStatus(..)+    , setFormat, setBase, setGraph+    , resetInfo, resetError, setStatus+    -- , setVerbose+    , SwishFormat(..)+    , swishError+    , reportLine+    )++import Swish.RDF.SwishScript+    ( parseScriptFromString+    )++import Swish.RDF.GraphPartition+    ( GraphPartition(..)+    , partitionGraph, comparePartitions+    , partitionShowP+    )++import Swish.RDF.RDFGraph+    ( RDFGraph, merge )++import qualified Swish.RDF.N3Formatter as N3F+import qualified Swish.RDF.NTFormatter as NTF++import Swish.RDF.N3Parser (parseN3) -- (parseN3fromString)+import Swish.RDF.NTParser (parseNT)++import Swish.RDF.GraphClass+    ( LDGraph(..)+    , Label(..)+    )++import Swish.Utils.QName (QName, qnameFromURI, qnameFromFilePath, getQNameURI)++import System.IO+    ( Handle, openFile, IOMode(..)+    , hPutStr, hPutStrLn, hClose, hGetContents+    , hIsReadable, hIsWritable+    , stdin, stdout+    )++import Network.URI (URI, +                    relativeTo,+                    parseURI, parseURIReference, uriToString)++import Control.Monad.Trans (MonadTrans(..))+import Control.Monad.State (modify, gets)+import Control.Monad (liftM, when)++import System.IO.Error++------------------------------------------------------------+--  Set file format to supplied value+------------------------------------------------------------++-- the second argument allows for options to be passed along+-- with the format (a la cwm) but this is not supported yet+--+swishFormat :: SwishFormat -> Maybe String -> SwishStateIO ()+swishFormat fmt _ = modify (setFormat fmt)++------------------------------------------------------------+--  Set base URI to supplied value+------------------------------------------------------------++-- the Maybe String argument is ignored (a result of a lack of+-- design with the command-line processing)+--+swishBase :: Maybe QName -> Maybe String -> SwishStateIO ()+swishBase mb _ = modify (setBase mb)++------------------------------------------------------------+--  Read graph from named file+------------------------------------------------------------++swishInput :: Maybe String -> SwishStateIO ()+swishInput fnam =+  swishReadGraph fnam >>= maybe (return ()) (modify . setGraph)+  +------------------------------------------------------------+--  Merge graph from named file+------------------------------------------------------------++swishMerge :: Maybe String -> SwishStateIO ()+swishMerge fnam =+  swishReadGraph fnam >>= maybe (return ()) (modify . mergeGraph)+    +mergeGraph :: RDFGraph -> SwishState -> SwishState+mergeGraph gr state = state { graph = newgr }+    where+        newgr = merge gr (graph state)++------------------------------------------------------------+--  Compare graph from named file+------------------------------------------------------------++swishCompare :: Maybe String -> SwishStateIO ()+swishCompare fnam =+  swishReadGraph fnam >>= maybe (return ()) compareGraph+    +compareGraph :: RDFGraph -> SwishStateIO ()+compareGraph gr = do+  oldGr <- gets graph+  let exitCode = if gr == oldGr then SwishSuccess else SwishGraphCompareError+  modify $ setStatus exitCode+  +------------------------------------------------------------+--  Display graph differences from named file+------------------------------------------------------------++swishGraphDiff :: Maybe String -> SwishStateIO ()+swishGraphDiff fnam =+  swishReadGraph fnam >>= maybe (return ()) diffGraph++diffGraph :: RDFGraph -> SwishStateIO ()+diffGraph gr = do+  oldGr <- gets graph+  let p1 = partitionGraph (getArcs oldGr)+      p2 = partitionGraph (getArcs gr)+      diffs = comparePartitions p1 p2+  maybehandleclose <- swishWriteFile Nothing+  case maybehandleclose of+    Just (h,c) -> do+      swishOutputDiffs "" h diffs+      when c (lift $ hClose h)+   +    _  -> return ()+  +swishOutputDiffs :: (Label lb) =>+    String -> Handle+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]+    -> SwishStateIO ()+swishOutputDiffs fnam hnd diffs = do+  lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))+  mapM_ (swishOutputDiff fnam hnd) (zip [1..] diffs)++swishOutputDiff :: (Label lb) =>+    String -> Handle+    -> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb)))+    -> SwishStateIO ()+swishOutputDiff fnam hnd (diffnum,(part1,part2)) = do+  lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")+  lift $ hPutStr hnd "Graph 1:"+  swishOutputPart fnam hnd part1+  lift $ hPutStr hnd "Graph 2:"+  swishOutputPart fnam hnd part2++swishOutputPart :: (Label lb) =>+    String -> Handle -> Maybe (GraphPartition lb) -> SwishStateIO ()+swishOutputPart _ hnd part = +  let out = maybe "\n(No arcs)" (partitionShowP "\n") part+  in lift $ hPutStrLn hnd out++------------------------------------------------------------+--  Execute script from named file+------------------------------------------------------------++swishScript :: Maybe String -> SwishStateIO ()+swishScript fnam = swishReadScript fnam >>= mapM_ swishCheckResult++swishReadScript :: Maybe String -> SwishStateIO [SwishStateIO ()]+swishReadScript fnam =+  let hdlr (h,i) = do+        res <- swishParseScript fnam i+        lift $ hClose h+        return res+  +  in swishOpenFile fnam >>= maybe (return []) hdlr++{-|+Calculate the base URI to use; it combines the file name+with any user-supplied base.++If both the file name and user-supplied base are Nothing+then the value ++   http://id.ninebynine.org/2003/Swish/++is used.++Needs some work.+-}++defURI :: QName+defURI = qnameFromURI "http://id.ninebynine.org/2003/Swish/"++calculateBaseURI ::+  Maybe FilePath -- ^ file name+  -> SwishStateIO QName -- ^ base URI+  +calculateBaseURI Nothing = maybe defURI id `liftM` gets base+    +calculateBaseURI (Just fnam) = do+  mbase <- gets base+  case mbase of+    Just buri -> case appendUris (getQNameURI buri) fnam of+      Left emsg -> fail emsg -- TODO: think about this ...+      Right res -> return $ qnameFromURI $ showURI res+    Nothing -> lift $ qnameFromFilePath fnam++-- this is also in N3Parser+showURI :: URI -> String+showURI u = uriToString id u ""++-- this is also in N3Parser+appendUris :: String -> String -> Either String URI+appendUris buri uri =+  case parseURI uri of+    Just absuri -> Right absuri+    _ -> case parseURIReference uri of+      Just reluri -> case parseURI buri of+        Just baseuri -> case relativeTo reluri baseuri of+          Just resuri -> Right resuri+          _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ buri ++ ">"+          +        _ -> Left $ "Invalid base URI: <" ++ buri ++ ">"+      _ -> Left $ "Invalid URI: <" ++ uri ++ ">"+      +swishParseScript ::+  Maybe String -- file name (or "stdin" if Nothing)+  -> String  -- script contents+  -> SwishStateIO [SwishStateIO ()]+swishParseScript mfpath inp = do+  buri <- calculateBaseURI mfpath+  case parseScriptFromString (Just buri) inp of+    Left err -> do+      let inName = maybe "standard input" ("file " ++) mfpath+      swishError ("Script syntax error in " ++ inName ++ ": "++err) SwishDataInputError+      return []+              +    Right scs -> return scs++swishCheckResult :: SwishStateIO () -> SwishStateIO ()+swishCheckResult swishcommand = do+  swishcommand+  er <- gets errormsg+  case er of  +    Just x -> swishError x SwishExecutionError >> modify resetError+    _      -> return ()+    +  ms <- gets infomsg+  case ms of+    Just x -> reportLine x >> modify resetInfo+    _      -> return ()++------------------------------------------------------------+--  Output graph to named file+------------------------------------------------------------++swishOutput :: Maybe String -> SwishStateIO ()+swishOutput fnam = +  let hdlr (h,c) = swishOutputGraph fnam h >> when c (lift $ hClose h)+  in swishWriteFile fnam >>= maybe (return ()) hdlr+     +swishOutputGraph :: Maybe String -> Handle -> SwishStateIO ()+swishOutputGraph _ hnd = do+  fmt <- gets format+  +  let writeOut formatter = do+        out <- gets $ formatter . graph+        lift $ hPutStrLn hnd (out "")+        +  case fmt of+    N3 -> writeOut N3F.formatGraphAsShowS+    NT -> writeOut NTF.formatGraphAsShowS+    -- _  -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError++------------------------------------------------------------+--  Common input functions+------------------------------------------------------------+--+--  Keep the logic separate for reading file data and+--  parsing it to an RDF graph value.++swishReadGraph :: Maybe String -> SwishStateIO (Maybe RDFGraph)+swishReadGraph fnam =+  let reader (h,i) = do+        res <- swishParse fnam i+        lift $ hClose h+        return res+  +  in swishOpenFile fnam >>= maybe (return Nothing) reader++-- Open and read file, returning its handle and content, or Nothing+-- WARNING:  the handle must not be closed until input is fully evaluated+--+swishOpenFile :: Maybe String -> SwishStateIO (Maybe (Handle,String))+swishOpenFile Nothing     = readFromHandle stdin "standard input."+swishOpenFile (Just fnam) = do+  o <- lift $ try $ openFile fnam ReadMode+  case o of+    Left  _ -> do+      swishError ("Cannot open file: "++fnam) SwishDataAccessError+      return Nothing+      +    Right hnd -> readFromHandle hnd ("file: " ++ fnam)++readFromHandle :: Handle -> String -> SwishStateIO (Maybe (Handle, String))+readFromHandle hdl lbl = do+  hrd <- lift $ hIsReadable hdl+  if hrd+    then do+      fc <- lift $ hGetContents hdl+      return $ Just (hdl,fc)+  +    else do+      -- closing stdin should not be an issue here?+      lift $ hClose hdl+      swishError ("Cannot read from " ++ lbl) SwishDataAccessError+      return Nothing++swishParse :: +  Maybe String -- ^ filename (if not stdin)+  -> String  -- ^ contents of file+  -> SwishStateIO (Maybe RDFGraph)+swishParse mfpath inp = do+  fmt <- gets format+  buri <- calculateBaseURI mfpath+  +  let toError eMsg =+        swishError (show fmt ++ " syntax error in " ++ inName ++ ": " ++ eMsg) SwishDataInputError +        >> return Nothing+        +      inName = maybe "standard input" ("file " ++) mfpath+  +      readIn reader = case reader inp of+        Left eMsg -> toError eMsg+        Right res -> return $ Just res+             +  case fmt of+    N3 -> readIn (flip parseN3 (Just buri))+    NT -> readIn parseNT+    {-+    _  -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError >>+          return Nothing+    -}+    +--  Open file for writing, returning its handle, or Nothing+--  Also returned is a flag indicating whether or not the+--  handled should be closed when writing is done (if writing+--  to standard output, the handle should not be closed as the+--  run-time system should deal with that).+swishWriteFile :: Maybe String -> SwishStateIO (Maybe (Handle,Bool))+swishWriteFile Nothing = do+  hwt <- lift $ hIsWritable stdout+  if hwt+    then return $ Just (stdout, False)+    else do+      swishError ("Cannot write to standard output") SwishDataAccessError+      return Nothing+  +swishWriteFile (Just fnam) = do+  o <- lift $ try $ openFile fnam WriteMode+  case o of+    Left _ -> do+      swishError ("Cannot open file for writing: " ++ fnam) SwishDataAccessError+      return Nothing+      +    Right hnd -> do+      hwt <- lift $ hIsWritable hnd+      if hwt+        then return $ Just (hnd, True)+        else do+          lift $ hClose hnd+          swishError ("Cannot write to file: "++fnam) SwishDataAccessError+          return Nothing+  +--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/SwishMain.hs view
@@ -0,0 +1,285 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  SwishMain+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  Swish:  Semantic Web Inference Scripting in Haskell+--+--  This program is a simple skeleton for constructing Semantic Web [1]+--  inference tools in Haskell, using the RDF graph and several RDF+--  parsers (at present Notation 3 and NTriples).+--+--  It might be viewed as a kind of embroyonic CWM [2] in Haskell, except+--  that the intent is that Haskell will be used as a primary language for+--  defining inferences.  As such, Swish is an open-ended toolkit for+--  constructing new special-purpose Semantic Web applications rather+--  than a closed, self-contained general-purpose SW application.+--  I anticipate that this module may be used as a starting point for+--  creating new programs rathar then as a complete program in its own right.+--  The functionality built into this code is selected with a view to testing+--  the Haskell modules for handling RDF rather than for performing any+--  particular application processing (though development as a tool with+--  some broader utility is not ruled out).  As such, it is part of+--  another experiment along the lines described in [3].+--+--  (1) Semantic web: <http://www.w3.org/2001/sw/>+--+--  (2) CWM:          <http://www.w3.org/2000/10/swap/doc/cwm.html>+--+--  (3) Motivation:   <http://www.w3.org/2000/10/swap/doc/Motivation.html>+--+--  (4) Notation 3:   <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>+--+--  (5) RDF:          <http://www.w3.org/RDF/>+--+--------------------------------------------------------------------------------++--  TODO:+--+--  * Add RDF/XML input and output+--+--  * Add Turtle and related formats for input and output+--++module Swish.RDF.SwishMain (+  SwishStatus(..), SwishAction,+  runSwish,+  runSwishActions,+  displaySwishHelp,+  splitArguments,+  validateCommands+  ) where++import Swish.RDF.SwishCommands+    ( swishFormat+    , swishBase+    , swishInput+    , swishOutput+    , swishMerge+    , swishCompare+    , swishGraphDiff+    , swishScript+    )++import Swish.RDF.SwishMonad+    ( SwishStateIO, SwishState(..), SwishStatus(..)+    , emptyState+    , SwishFormat(..)+    )++import Swish.Utils.QName (qnameFromURI)+import Swish.Utils.ListHelpers (breakAll)++import Control.Monad.State (execStateT)+import Control.Monad (liftM)++import Network.URI (parseURI)++import Data.Char (isSpace)+import Data.Either (partitionEithers)++import System.Exit (ExitCode(ExitSuccess, ExitFailure))++------------------------------------------------------------+--  Command line description+------------------------------------------------------------++-- we do not display the version in the help file to avoid having+-- to include the Paths_swish module (so that we can use this from+-- an interactive environment).+--++usageText :: [String]+usageText =+    [ "Swish: Read, merge, write, compare and process RDF graphs."+    , ""+    , "Usage: swish option option ..."+    , ""+    , "where the options are processed from left to right, and may be"+    , "any of the following:"+    , "-h        display this message."+    , "-?        display this message."+    , "-v        display Swish version and quit."+    , "-q        do not display Swish version on start up."+    , "-nt       use Ntriples format for subsequent input and output."+    , "-n3       use Notation3 format for subsequent input and output (default)"+    , "-i[=file] read file in selected format into the graph workspace,"+    , "          replacing any existing graph."+    , "-m[=file] merge file in selected format with the graph workspace."+    , "-c[=file] compare file in selected format with the graph workspace."+    , "-d[=file] show graph differences between the file in selected"+    , "          format and the graph workspace.  Differences are displayed"+    , "          to the standard output stream."+    , "-o[=file] write the graph workspace to a file in the selected format."+    , "-s[=file] read and execute Swish script commands from the named file."+    , "-b[=base] set or clear the base URI. The semantics of this are not"+    , "          fully defined yet."+    , ""+    , "    If an optional filename value is omitted, the standard input"+    , "    or output stream is used, as appropriate."+    , ""+    , "Exit status codes:"+    , "Success - operation completed successfully/graphs compare equal"+    , "1 - graphs compare different"+    , "2 - input data format error"+    , "3 - file access problem"+    , "4 - command line error"+    , "5 - script file execution error"+    , ""+    , "Examples:"+    , ""+    , "swish -i=file"+    , "    read file as Notation3, and report any syntax errors."+    , "swish -i=file1 -o=file2"+    , "    read file1 as Notation3, report any syntax errors, and output the"+    , "    resulting graph as reformatted Notation3 (the output format"+    , "    is not perfect but may be improved)."+    , "swish -nt -i=file -n3 -o"+    , "    read file as NTriples and output as Notation3 to the screen."+    , "swich -i=file1 -c=file2"+    , "    read file1 and file2 as notation3, report any syntax errors, and"+    , "    if both are OK, compare the resulting graphs to indicate whether"+    , "    or not they are equivalent."+    ]++-- | Write out the help for Swish+displaySwishHelp :: IO ()+displaySwishHelp = mapM_ putStrLn usageText++------------------------------------------------------------+--  Swish command line interpreter+------------------------------------------------------------+--+--  This is a composite monad combining some state with an IO+--  Monad.  lift allows a pure IO monad to be used as a step+--  of the computation.+--+        +-- | Return any arguments that need processing immediately, namely                     +-- the \"help\", \"quiet\" and \"version\" options.+--+splitArguments :: [String] -> ([String], [String])+splitArguments = partitionEithers . map splitArgument++splitArgument :: String -> Either String String+splitArgument "-?" = Left "-h"+splitArgument "-h" = Left "-h"+splitArgument "-v" = Left "-v"+splitArgument "-q" = Left "-q"+splitArgument x    = Right x++-- | Represent an Swish action, with an optional argument and+-- the Swish routine to act on that argument.+-- +-- At present this type is a black box to external modules.+newtype SwishAction = SA (Maybe String, Maybe String -> SwishStateIO ())++-- | Given a list of command-line arguments create the list of actions+-- to perform or a string and status value indicating an input error.+validateCommands :: [String] -> Either (String, SwishStatus) [SwishAction]+validateCommands args = +  let (ls, rs) = partitionEithers (map validateCommand args)+  in case ls of+    (e:_) -> Left e+    []    -> Right rs+  +-- This allows you to say "-nt=foo" and currently ignores the values+-- passed through. This may change+--    +validateCommand :: String -> Either (String, SwishStatus) SwishAction+validateCommand cmd =+  let (nam,more) = break (=='=') cmd+      arg        = drop 1 more+      marg       = if null arg then Nothing else Just arg+      +      wrap f = Right $ SA (marg, f)+  in case nam of+    "-nt"   -> wrap $ swishFormat NT+    "-n3"   -> wrap $ swishFormat N3+    "-i"    -> wrap swishInput+    "-m"    -> wrap swishMerge+    "-c"    -> wrap swishCompare+    "-d"    -> wrap swishGraphDiff+    "-o"    -> wrap swishOutput+    "-b"    -> validateBase marg+    "-s"    -> wrap swishScript+    _       -> Left ("Invalid command line argument: "++cmd, SwishArgumentError)++-- | Execute the given set of actions.+swishCommands :: [SwishAction] -> SwishStateIO ()+swishCommands = mapM_ swishCommand++-- | Execute an action.+swishCommand :: SwishAction -> SwishStateIO ()+swishCommand (SA (marg,act)) = act marg++validateBase :: Maybe String -> Either (String, SwishStatus) SwishAction+validateBase Nothing  = Right $ SA (Nothing, swishBase Nothing)+validateBase (Just b) =+  case parseURI b of+    Just _ -> Right $ SA (Nothing, swishBase (Just (qnameFromURI b)))+    _      -> Left ("Invalid base URI <" ++ b ++ ">", SwishArgumentError)+  +------------------------------------------------------------+--  Interactive test function (e.g. for use in Hugs)+------------------------------------------------------------++-- this ignores the "flags" options, namely+--    -q / -h / -? / -v++-- | Parse and run the given string as if given at the command+-- line. The \"quiet\", \"version\" and \"help\" options are+-- ignored.+--+runSwish :: String -> IO ExitCode+runSwish cmdline = do+  let args = breakAll isSpace cmdline+      (_, cmds) = splitArguments args+      +  case validateCommands cmds of+    Left (emsg, ecode) -> do+      putStrLn $ "Swish exit: " ++ emsg+      return $ ExitFailure $ fromEnum ecode+      +    Right acts -> do+      ec <- runSwishActions acts+      case ec of+        SwishSuccess -> return ExitSuccess+        _  -> do+          putStrLn $ "Swish exit: " ++ show ec+          return $ ExitFailure $ fromEnum ec++-- | Execute the given set of actions.+runSwishActions :: [SwishAction] -> IO SwishStatus+runSwishActions acts = exitcode `liftM` execStateT (swishCommands acts) emptyState++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/SwishMonad.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  SwishMonad+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  FlexibleInstances, MultiParamTypeClasses+--+--  Composed state and IO monad for Swish+--+--------------------------------------------------------------------------------++module Swish.RDF.SwishMonad+    ( SwishStateIO, SwishState(..), SwishStatus(..)+    , setFormat, setBase, setGraph+    , modGraphs, findGraph, findFormula+    , modRules, findRule+    , modRulesets, findRuleset+    , findOpenVarModify, findDatatype+    , setInfo, resetInfo, setError, resetError+    , setStatus+    -- , setVerbose+    , emptyState+    , SwishFormat(..)+    , NamedGraph(..), NamedGraphMap+    , swishError+    , reportLines, reportLine+    )+where++import Swish.RDF.RDFGraph+    ( RDFGraph, emptyRDFGraph )++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleMap, RDFRuleset, RDFRulesetMap )++import Swish.RDF.RDFDatatype+    ( RDFDatatype )++import Swish.RDF.RDFVarBinding+    ( RDFOpenVarBindingModify+    )++import Swish.RDF.BuiltInMap+    ( findRDFOpenVarBindingModifier+    , findRDFDatatype+    , rdfRulesetMap+    )++import Swish.RDF.Ruleset+    ( getMaybeContextAxiom+    , getMaybeContextRule+    )++import Swish.RDF.Rule+    ( Formula(..)+    )++import Swish.Utils.Namespace (ScopedName(..))+import Swish.Utils.QName (QName)++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , emptyLookupMap+    , mapFindMaybe+    , mapVals+    )++import Control.Monad.Trans (MonadTrans(..))+import Control.Monad.State (StateT(..), modify)++import System.IO (hPutStrLn, stderr)++{-|+The supported input and output formats.+-}+data SwishFormat = +  N3  -- ^ N3 format+  | NT -- ^ NTriples format+    deriving Eq++instance Show SwishFormat where+  show N3  = "N3"+  show NT  = "Ntriples"+  -- show RDF = "RDF/XML"++-- | The State for a Swish \"program\".+  +data SwishState = SwishState+    { format    :: SwishFormat      -- ^ format to use for I/O+    , base      :: Maybe QName      -- ^ base to use rather than file name+    , graph     :: RDFGraph         -- ^ current graph+    , graphs    :: NamedGraphMap    -- ^ script processor named graphs+    , rules     :: RDFRuleMap       -- ^ script processor named rules+    , rulesets  :: RDFRulesetMap    -- ^ script processor rulesets+    , infomsg   :: Maybe String     -- ^ information message, or Nothing+    , errormsg  :: Maybe String     -- ^ error message, or Nothing+    , exitcode  :: SwishStatus      -- ^ current status message+    }++-- | Status of the processor+--+data SwishStatus =+  SwishSuccess               -- ^ successful run+  | SwishGraphCompareError   -- ^ graphs do not compare+  | SwishDataInputError      -- ^ input data problem (ie format/syntax)+  | SwishDataAccessError     -- ^ data access error+  | SwishArgumentError       -- ^ command-line argument error+  | SwishExecutionError      -- ^ error executing a Swish script+    deriving (Eq, Enum)++instance Show SwishStatus where+  show SwishSuccess           = "Success."+  show SwishGraphCompareError = "The graphs do not compare as equal."+  show SwishDataInputError    = "There was a format or syntax error in the input data."+  show SwishDataAccessError   = "There was a problem accessing data."+  show SwishArgumentError     = "Argument error: use -h or -? for help."+  show SwishExecutionError    = "There was a problem executing a Swish script."++type SwishStateIO a = StateT SwishState IO a++emptyState :: SwishState+emptyState = SwishState+    { format    = N3+    , base      = Nothing+    , graph     = emptyRDFGraph+    , graphs    = emptyLookupMap+    , rules     = emptyLookupMap+    , rulesets  = rdfRulesetMap+    , infomsg   = Nothing+    , errormsg  = Nothing+    , exitcode  = SwishSuccess+    }++setFormat :: SwishFormat -> SwishState -> SwishState+setFormat   fm state = state { format = fm }++setBase :: Maybe QName -> SwishState -> SwishState+setBase bs state = state { base = bs }++setGraph :: RDFGraph -> SwishState -> SwishState+setGraph    gr state = state { graph = gr }++modGraphs ::+    ( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState+modGraphs grmod state = state { graphs = grmod (graphs state) }++findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]+findGraph nam state = mapFindMaybe nam (graphs state)++findFormula :: ScopedName -> SwishState -> Maybe RDFFormula+findFormula nam state = case findGraph nam state of+        Nothing  -> getMaybeContextAxiom nam (mapVals $ rulesets state)+        Just []  -> Just $ Formula nam emptyRDFGraph+        Just grs -> Just $ Formula nam (head grs)++modRules ::+    ( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState+modRules rlmod state = state { rules = rlmod (rules state) }++findRule :: ScopedName -> SwishState -> Maybe RDFRule+findRule nam state =+    let+        localrule   = mapFindMaybe nam (rules state)+        contextrule = getMaybeContextRule nam $ mapVals $ rulesets state+    in+        case localrule of+            Nothing -> contextrule+            justlr  -> justlr++modRulesets ::+    ( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState+modRulesets rsmod state = state { rulesets = rsmod (rulesets state) }++findRuleset ::+    ScopedName -> SwishState -> Maybe RDFRuleset+findRuleset nam state = mapFindMaybe (snScope nam) (rulesets state)++findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify+findOpenVarModify nam _ = findRDFOpenVarBindingModifier nam++findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype+findDatatype nam _ = findRDFDatatype nam++setInfo :: String -> SwishState -> SwishState+setInfo msg state = state { infomsg = Just msg }++resetInfo :: SwishState -> SwishState+resetInfo state = state { infomsg = Nothing }++setError :: String -> SwishState -> SwishState+setError msg state = state { errormsg = Just msg }++resetError :: SwishState -> SwishState+resetError state = state { errormsg = Nothing }++setStatus :: SwishStatus -> SwishState -> SwishState+setStatus ec state = state { exitcode = ec }++{-+setVerbose :: Bool -> SwishState -> SwishState+setVerbose f state = state { banner = f }+-}++-- | The graphs dictionary contains named graphs and/or lists+--  of graphs that are created and used by script statements.++data NamedGraph = NamedGraph+    { ngName    :: ScopedName+    , ngGraph   :: [RDFGraph]+    }++instance LookupEntryClass NamedGraph ScopedName [RDFGraph]+    where+        keyVal   (NamedGraph k v) = (k,v)+        newEntry (k,v)            = NamedGraph k v++type NamedGraphMap = LookupMap NamedGraph++-- | Report error and set exit status code++swishError :: String -> SwishStatus -> SwishStateIO ()+swishError msg sts = do+  reportLines [msg, show sts ++ "\n"]+  -- when (sts == 4) $ reportLine "Use 'Swish -h' or 'Swish -?' for help\n"+  modify $ setStatus sts++-- | Output text to the standard error stream+--+--  Each string in the supplied list is a line of text to+--  be displayed.++reportLines  :: [String] -> SwishStateIO ()+reportLines = mapM_ reportLine ++reportLine  :: String -> SwishStateIO ()+reportLine line =+    -- lift putStrLn line+    lift $ hPutStrLn stderr line++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/SwishScript.hs view
@@ -0,0 +1,961 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  SwishScript+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  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.+--+--  The script syntax is based loosely on Notation3, and the script parser is an+--  extension of the Notation3 parser in the module "Swish.RDF.N3Parser".+--+--------------------------------------------------------------------------------++module Swish.RDF.SwishScript+    ( parseScriptFromString )+where++import Swish.RDF.SwishMonad+    ( SwishStateIO, SwishStatus(..) +    , modGraphs, findGraph, findFormula+    , modRules, findRule+    , modRulesets, findRuleset+    , findOpenVarModify, findDatatype+    , setInfo, setError, setStatus+    , NamedGraph(..)+    )++import Swish.RDF.RDFDatatype+    ( RDFDatatype )++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule+    , RDFRuleset+    , makeRDFClosureRule+    )++import Swish.RDF.RDFProof+    ( RDFProofStep, makeRDFProof, makeRDFProofStep )++import Swish.RDF.RDFVarBinding+    ( RDFVarBindingModify+    )++import Swish.RDF.RDFGraphShowM()++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , emptyRDFGraph+    , NamespaceMap+    , setNamespaces+    , merge, add+    )++import Swish.RDF.N3Parser+    ( parseAnyfromString+    , parseN3      +    , N3Parser, N3State(..)+    , whiteSpace, symbol, eof, identLetter+    , getPrefix+    , subgraph+    , n3symbol -- was uriRef2,+    , quickVariable -- was varid+    , lexUriRef+    , newBlankNode+    )++import Swish.RDF.N3Formatter+    ( formatGraphAsShowS )++import Swish.RDF.Datatype+    ( typeMkRules )++import Swish.RDF.Proof+    ( explainProof, showsProof )++import Swish.RDF.Ruleset+    ( makeRuleset, getRulesetRule, getMaybeContextRule )++import Swish.RDF.Rule+    ( Formula(..), Rule(..) -- , RuleMap+    )++import Swish.RDF.VarBinding+    ( composeSequence )++import Swish.Utils.Namespace+    ( ScopedName(..) )++import Swish.Utils.QName (QName, qnameFromURI)++import Swish.Utils.LookupMap+    ( mapReplaceOrAdd )++import Swish.Utils.ListHelpers+    ( equiv, flist )++import Text.ParserCombinators.Parsec+    ( (<?>), (<|>)+    , many, manyTill, option, sepBy, between, try, notFollowedBy+    , string, char, anyChar+    , getState+    )++import Control.Monad.State+    ( modify, gets, lift+    -- , StateT(..), execStateT+    )++import Control.Monad (unless, when, liftM)++import qualified System.IO.Error as IO++------------------------------------------------------------+--  Parser for Swish script processor+------------------------------------------------------------+--+--  The parser is based on the Notation3 parser, and uses many+--  of the same syntax productions, but the top-level productions used+--  are quite different.+--+-- NOTE: during the parser re-write we strip out some of this functionality+-- +parseScriptFromString :: Maybe QName -> String -> Either String [SwishStateIO ()]+parseScriptFromString = parseAnyfromString script ++----------------------------------------------------------------------+--  Syntax productions+----------------------------------------------------------------------++script :: N3Parser [SwishStateIO ()]+script = do+  whiteSpace+  scs <- many command+  eof+  return scs++isymbol :: String -> N3Parser ()+isymbol s = symbol s >> return ()++command :: N3Parser (SwishStateIO ())+command =+        do  { try $ isymbol "@prefix"+            ; getPrefix+            ; return $ return ()+            }+    <|> nameItem+    <|> readGraph+    <|> writeGraph+    <|> mergeGraphs+    <|> compareGraphs+    <|> assertEquiv+    <|> assertMember+    <|> defineRule+    <|> defineRuleset+    <|> defineConstraints+    <|> checkProofCmd+    <|> fwdChain+    <|> bwdChain+    <?>+        "script command"++nameItem :: N3Parser (SwishStateIO ())+nameItem =+        --  name :- graph+        --  name :- ( graph* )+        do  { u <- n3symbol+            ; isymbol ":-"+            ; g <- graphOrList+            ; return $ ssAddGraph u g+            }++readGraph :: N3Parser (SwishStateIO ())+readGraph =+        --  @read name  [ <uri> ]+        do  { commandName "@read"+            ; n <- n3symbol+            ; u <- option "" lexUriRef+            ; return $ ssRead n (if null u then Nothing else Just u)+            }++writeGraph :: N3Parser (SwishStateIO ())+writeGraph =+        --  @write name [ <uri> ] ; Comment+        do  { commandName "@write"+            ; n <- n3symbol+            ; let gs = ssGetList n :: SwishStateIO (Either String [RDFGraph])+            ; u <- option "" lexUriRef+            ; isymbol ";"+            ; c <- restOfLine+            ; let muri = if null u then Nothing else Just u+            ; return $ ssWriteList muri gs c+            }++mergeGraphs :: N3Parser (SwishStateIO ())+mergeGraphs =+        --  @merge ( name* ) => name+        do  { commandName "@merge"+            ; gs <- graphList+            ; isymbol "=>"+            ; n <- n3symbol+            ; return $ ssMerge n gs+            }++compareGraphs :: N3Parser (SwishStateIO ())+compareGraphs =+        --  @compare  name name+        do  { commandName "@compare"+            ; n1 <- n3symbol+            ; n2 <- n3symbol+            ; return $ ssCompare n1 n2+            }++assertEquiv :: N3Parser (SwishStateIO ())+assertEquiv =+        --  @asserteq name name ; Comment+        do  { commandName "@asserteq"+            ; n1 <- n3symbol+            ; n2 <- n3symbol+            ; isymbol ";"+            ; c <- restOfLine+            ; return $ ssAssertEq n1 n2 c+            }++assertMember :: N3Parser (SwishStateIO ())+assertMember =+        --  @assertin name name ; Comment+        do  { commandName "@assertin"+            ; n1 <- n3symbol+            ; n2 <- n3symbol+            ; isymbol ";"+            ; c <- restOfLine+            ; return $ ssAssertIn n1 n2 c+            }++defineRule :: N3Parser (SwishStateIO ())+defineRule =+        --  @rule name :- ( name* ) => name [ | ( (name var*)* ) ]+        do  { commandName "@rule"+            ; rn <- n3symbol+            ; isymbol ":-"+            ; ags <- graphOrList+            ; isymbol "=>"+            ; cg  <- graphExpr+            ; vms <- option [] varModifiers+            ; return $ ssDefineRule rn ags cg vms+            }++defineRuleset :: N3Parser (SwishStateIO ())+defineRuleset =+        --  @ruleset name :- ( name* ) ; ( name* )+        do  { commandName "@ruleset"+            ; sn <- n3symbol+            ; isymbol ":-"+            ; ags <- nameList+            ; isymbol ";"+            ; rns <- nameList+            ; return $ ssDefineRuleset sn ags rns+            }++defineConstraints :: N3Parser (SwishStateIO ())+defineConstraints =+        --  @constraints pref :- ( name* ) | ( name* )+        do  { commandName "@constraints"+            ; sn <- n3symbol+            ; isymbol ":-"+            ; cgs <- graphOrList+            ; isymbol "|"+            ; cns <- nameOrList+            ; return $ ssDefineConstraints sn cgs cns+            }++checkProofCmd :: N3Parser (SwishStateIO ())+checkProofCmd =+        --  @proof name ( name* )+        --    @input name+        --    @step name ( name* ) => name  # rule-name, antecedents, consequent+        --    @result name+        do  { commandName "@proof"+            ; pn  <- n3symbol+            ; sns <- nameList+            ; commandName "@input"+            ; igf <- formulaExpr+            ; sts <- many checkStep+            ; commandName "@result"+            ; rgf <- formulaExpr+            ; return $ ssCheckProof pn sns igf sts rgf+            }++checkStep ::+    N3Parser (Either String [RDFRuleset]+                -> SwishStateIO (Either String RDFProofStep))+checkStep =+        do  { commandName "@step"+            ; rn   <- n3symbol+            ; agfs <- formulaList+            ; isymbol "=>"+            ; cgf  <- formulaExpr+            ; return $ ssCheckStep rn agfs cgf+            }++fwdChain :: N3Parser (SwishStateIO ())+fwdChain =+        --  #   ruleset rule (antecedents) => result+        --  @fwdchain pref name ( name* ) => name+        do  { commandName "@fwdchain"+            ; sn  <- n3symbol+            ; rn  <- n3symbol+            ; ags <- graphOrList+            ; isymbol "=>"+            ; cn  <- n3symbol+            ; s <- getState             :: N3Parser N3State+            ; let prefs = prefixUris s  :: NamespaceMap+            ; return $ ssFwdChain sn rn ags cn prefs+            }++bwdChain :: N3Parser (SwishStateIO ())+bwdChain =+        --  #   ruleset rule consequent <= (antecedent-alts)+        --  @bwdchain pref name graph <= name+        do  { commandName "@bwdchain"+            ; sn  <- n3symbol+            ; rn  <- n3symbol+            ; cg  <- graphExpr+            ; isymbol "<="+            ; an  <- n3symbol+            ; s <- getState             :: N3Parser N3State+            ; let prefs = prefixUris s  :: NamespaceMap+            ; return $ ssBwdChain sn rn cg an prefs+            }++----------------------------------------------------------------------+--  Syntax clause helpers+----------------------------------------------------------------------++commandName :: String -> N3Parser ()+commandName cmd = try $+        do  { _ <- string cmd+            ; notFollowedBy identLetter+            ; whiteSpace+            }++restOfLine :: N3Parser String+restOfLine =+        do  { s <- manyTill anyChar (char '\n')+            ; whiteSpace+            ; return s+            }++nameList :: N3Parser [ScopedName]+nameList =+        do  { isymbol "("+            ; ns <- many n3symbol+            ; isymbol ")"+            ; return ns+            }++nameOrList :: N3Parser [ScopedName]+nameOrList =+        do  { n <- n3symbol+            ; return [n]+            }+    <|>+        nameList+    <?>+        "Name, or list of names"++graphExpr :: N3Parser (SwishStateIO (Either String RDFGraph))+graphExpr =+        graphOnly+    <|>+        do  { f <- formulaExpr+            ; return $ liftM (liftM formExpr) f+            }+    <?>+        "Graph expression, graph name or named graph definition"++graphOnly :: N3Parser (SwishStateIO (Either String RDFGraph))+graphOnly =+        do  { isymbol "{"+            ; b <- newBlankNode+            ; g <- subgraph b       :: N3Parser RDFGraph+            ; isymbol "}"+            ; s <- getState+            ; let gp = setNamespaces (prefixUris s) g+            ; return $ return (Right gp)+            }++graphList :: N3Parser [SwishStateIO (Either String RDFGraph)]+graphList = between (symbol "(") (symbol ")") (many graphExpr)+    <?>+        "List of graphs"++graphOrList :: N3Parser [SwishStateIO (Either String RDFGraph)]+graphOrList =+        do  { g <- graphExpr+            ; return [g]+            }+    <|>+        graphList+    <?>+        "Graph, or list of graphs"++formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula))+formulaExpr =+        do  { n <- n3symbol+            ; namedGraph n+            }+    <?> "Formula (name or named graph)"++namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either String RDFFormula))+namedGraph n =+        do  { isymbol ":-"+            ; g <- graphOnly+            ; return $ ssAddReturnFormula n g+            }+    <|>+        return (ssGetFormula n)++formulaList :: N3Parser [SwishStateIO (Either String RDFFormula)]+formulaList = between (symbol "(") (symbol ")") (many formulaExpr)+    <?>+        "List of formulae (names or named graphs)"++varModifiers :: N3Parser [(ScopedName,[RDFLabel])]+varModifiers =+        do  { isymbol "|"+            ; varModList+            }++varModList :: N3Parser [(ScopedName,[RDFLabel])]+varModList =+        do  { isymbol "("+            ; vms <- sepBy varMod (symbol ",")+            ; isymbol ")"+            ; return vms+            }+    <|>+        do  { vm <- varMod+            ; return [vm]+            }++varMod :: N3Parser (ScopedName,[RDFLabel])+varMod =+        do  { rn  <- n3symbol+            ; vns <- many quickVariable+            ; return (rn,vns)+            }++----------------------------------------------------------------------+--  SwishState helper functions+----------------------------------------------------------------------+--+--  The functions below operate in the SwishStateIO monad, and are used+--  to assemble an executable version of the parsed script.++ssAddReturnFormula ::+    ScopedName -> SwishStateIO (Either String RDFGraph)+    -> SwishStateIO (Either String RDFFormula)+ssAddReturnFormula nam gf =+        do  { egr <- gf+            ; ssAddGraph nam [return egr]+            ; return $ liftM (Formula nam) egr+            }++ssAddGraph ::+    ScopedName -> [SwishStateIO (Either String RDFGraph)]+    -> SwishStateIO ()+ssAddGraph nam gf =+    let errmsg = "Graph/list not added: "++show nam++"; "+    in+        do  { esg <- sequence gf        -- [Either String RDFGraph]+            ; let egs = sequence esg    -- Either String [RDFGraph]+            ; let fgs = case egs of+                    Left  er -> setError  (errmsg++er)+                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam gs))+            ; modify fgs+            }++ssGetGraph :: ScopedName -> SwishStateIO (Either String RDFGraph)+ssGetGraph nam =+        do  { grs <- ssGetList nam+            ; return $ liftM head grs+            }++ssGetFormula :: ScopedName -> SwishStateIO (Either String RDFFormula)+ssGetFormula nam = gets find+    where+        find st = case findFormula nam st of+            Nothing -> Left ("Formula not present: "++show nam)+            Just gr -> Right gr++ssGetList :: ScopedName -> SwishStateIO (Either String [RDFGraph])+ssGetList nam = gets find+    where+        find st = case findGraph nam st of+            Nothing  -> Left ("Graph or list not present: "++show nam)+            Just grs -> Right grs++ssRead :: ScopedName -> Maybe String -> SwishStateIO ()+ssRead nam muri = ssAddGraph nam [ssReadGraph muri]++ssReadGraph :: Maybe String -> SwishStateIO (Either String RDFGraph)+ssReadGraph muri = +  let gf inp = case inp of+        Left  es -> Left es+        Right is -> parseN3 is (fmap qnameFromURI muri)+        +  in gf `liftM` getResourceData muri++ssWriteList ::+    Maybe String -> SwishStateIO (Either String [RDFGraph]) -> String+    -> SwishStateIO ()+ssWriteList muri gf comment =+        do  { esgs <- gf+            ; case esgs of+                Left  er   -> modify $ setError ("Cannot write list: "++er)+                Right [gr] -> ssWriteGraph muri gr comment+                Right grs  -> sequence_ writegrs where+                    writegrs = if null grs+                        then [putResourceData Nothing ("+ Swish: Writing empty list"++)]+                        else map writegr (zip [(0::Int)..] grs)+                    writegr (n,gr) = ssWriteGraph (murin muri n) gr+                        ("["++show n++"] "++comment)+                    murin Nothing    _ = Nothing+                    murin (Just uri) n = Just (inituri++show n++lasturi)+                        where+                            splituri1 = splitBy (=='/') uri+                            splituri2 = splitBy (=='.') (lastseg splituri1)+                            inituri   = concat (initseg splituri1 ++ initseg splituri2)+                            lasturi   = lastseg splituri2+            }++splitBy :: (a->Bool) -> [a] -> [[a]]+splitBy _ []  = []+splitBy p (s0:str) = let (s1,sr) = break p str in+    (s0:s1):splitBy p sr++lastseg :: [[a]] -> [a]+lastseg []   = []+lastseg [_]  = []+lastseg ass  = last ass++initseg :: [[a]] -> [[a]]+initseg []   = []+initseg [as] = [as]+initseg ass  = init ass++{-+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 String -> RDFGraph -> String -> SwishStateIO ()+ssWriteGraph muri gr comment =+    putResourceData muri ((c++) . formatGraphAsShowS gr)+    where+        c = "# "++comment++"\n"++ssMerge ::+    ScopedName -> [SwishStateIO (Either String RDFGraph)]+    -> SwishStateIO ()+ssMerge nam gfs =+    let errmsg = "Graph merge not defined: "++show nam++"; "+    in+        do  { esg <- sequence gfs       -- [Either String RDFGraph]+            ; let egs = sequence esg    -- Either String [RDFGraph]+            ; let fgs = case egs of+                    Left  er -> setError  (errmsg++er)+                    Right [] -> setError  (errmsg++"No graphs to merge")+                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam [g]))+                            where g = foldl1 merge gs+            ; modify fgs+            }++ssCompare :: ScopedName -> ScopedName -> SwishStateIO ()+ssCompare n1 n2 =+        do  { g1 <- ssGetGraph n1+            ; g2 <- ssGetGraph n2+            ; when (g1 /= g2) (modify $ setStatus SwishGraphCompareError)+            }++ssAssertEq :: ScopedName -> ScopedName -> String -> SwishStateIO ()+ssAssertEq n1 n2 comment =+    let er1 = ":\n  Graph or list compare not performed:  invalid graph/list."+    in+        do  { g1 <- ssGetList n1+            ; g2 <- ssGetList n2+            ; case (g1,g2) of+                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)+                (_,Left er) -> modify $ setError (comment++er1++"\n  "++er)+                (Right gr1,Right gr2) ->+                    unless (equiv gr1 gr2) $ modify $+                      setError (comment++":\n  Graph "++show n1+                                ++" differs from "++show n2++".")+            }++ssAssertIn :: ScopedName -> ScopedName -> String -> SwishStateIO ()+ssAssertIn n1 n2 comment =+    let er1 = ":\n  Membership test not performed:  invalid graph."+        er2 = ":\n  Membership test not performed:  invalid list."+    in+        do  { g1 <- ssGetGraph n1+            ; g2 <- ssGetList  n2+            ; case (g1,g2) of+                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)+                (_,Left er) -> modify $ setError (comment++er2++"\n  "++er)+                (Right gr,Right gs) ->+                    unless (gr `elem` gs) $ modify $+                    setError (comment++":\n  Graph "++show n1+                              ++" not a member of "++show 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 rn agfs cgf vmds =+    let errmsg1 = "Rule definition error in antecedent graph(s): "+        errmsg2 = "Rule definition error in consequent graph: "+        errmsg3 = "Rule definition error in variable modifier(s): "+        errmsg4 = "Incompatible variable binding modifier sequence"+    in+        do  { aesg <- sequence agfs     -- [Either String RDFGraph]+            ; let ags = sequence aesg   :: Either String [RDFGraph]+            ; cg <- cgf                 -- Either String RDFGraph+            ; let vmfs = map ssFindVarModify vmds+            ; evms <- sequence vmfs     -- [Either String RDFVarBindingModify]+            ; let vms = sequence evms   :: Either String [RDFVarBindingModify]+            ; let frl = case (ags,cg,vms) of+                    (Left er,_,_) -> setError (errmsg1++er)+                    (_,Left er,_) -> setError (errmsg2++er)+                    (_,_,Left er) -> setError (errmsg3++er)+                    (Right agrs,Right cgr,Right vbms) ->+                        let+                            newRule = makeRDFClosureRule rn agrs cgr+                        in+                        case composeSequence vbms of+                            Just vm -> modRules (mapReplaceOrAdd (newRule vm))+                            Nothing -> setError errmsg4+            ; modify frl+            }++ssFindVarModify ::+    (ScopedName,[RDFLabel]) -> SwishStateIO (Either String RDFVarBindingModify)+ssFindVarModify (nam,lbs) = gets $ \st ->+  case findOpenVarModify nam st of+    Just ovbm -> Right (ovbm lbs)+    Nothing   -> Left  ("Undefined modifier: "++show nam)++ssDefineRuleset ::+    ScopedName+    -> [ScopedName]+    -> [ScopedName]+    -> SwishStateIO ()+ssDefineRuleset sn ans rns =+    let errmsg1 = "Error in ruleset axiom(s): "+        errmsg2 = "Error in ruleset rule(s): "+    in+        do  { let agfs = mapM ssGetFormula ans+                                        :: SwishStateIO [Either String RDFFormula]+            ; aesg <- agfs              -- [Either String RDFFormula]+            ; let eags = sequence aesg  :: Either String [RDFFormula]+            ; let erlf = mapM ssFindRule rns+                                        :: SwishStateIO [Either String RDFRule]+            ; rles <- erlf              -- [Either String RDFRule]+            ; let erls = sequence rles  :: Either String [RDFRule]+            ; let frs = case (eags,erls) of+                    (Left er,_) -> setError (errmsg1++er)+                    (_,Left er) -> setError (errmsg2++er)+                    (Right ags,Right rls) ->+                        modRulesets (mapReplaceOrAdd rs)+                        where+                            rs = makeRuleset (snScope sn) ags rls+            ; modify frs+            }++ssFindRule :: ScopedName -> SwishStateIO (Either String RDFRule)+ssFindRule nam = gets find+    where+        find st = case findRule nam st of+            Nothing -> Left ("Rule not found: "++show nam)+            Just rl -> Right rl++ssDefineConstraints  ::+    ScopedName+    -> [SwishStateIO (Either String RDFGraph)]+    -> [ScopedName]+    -> SwishStateIO ()+ssDefineConstraints  sn cgfs dtns =+    let errmsg1 = "Error in constraint graph(s): "+        errmsg2 = "Error in datatype(s): "+    in+        do  { cges <- sequence cgfs     -- [Either String RDFGraph]+            ; let ecgs = sequence cges  :: Either String [RDFGraph]+            ; let ecgr = case ecgs of+                    Left er   -> Left er+                    Right []  -> Right emptyRDFGraph+                    Right grs -> Right $ foldl1 merge grs+            ; edtf <- mapM ssFindDatatype dtns+                                        -- [Either String RDFDatatype]+            ; let edts = sequence edtf   :: Either String [RDFDatatype]+            ; let frs = case (ecgr,edts) of+                    (Left er,_) -> setError (errmsg1++er)+                    (_,Left er) -> setError (errmsg2++er)+                    (Right cgr,Right dts) ->+                        modRulesets (mapReplaceOrAdd rs)+                        where+                            rs  = makeRuleset (snScope sn) [] rls+                            rls = concatMap (`typeMkRules` cgr) dts+            ; modify frs+            }++ssFindDatatype :: ScopedName -> SwishStateIO (Either String RDFDatatype)+ssFindDatatype nam = gets find+    where+        find st = case findDatatype nam st of+            Nothing -> Left ("Datatype not found: "++show nam)+            Just dt -> Right 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 pn sns igf stfs rgf =+    let+        infmsg1 = "Proof satisfied: "+        errmsg1 = "Error in proof ruleset(s): "+        errmsg2 = "Error in proof input: "+        errmsg3 = "Error in proof step(s): "+        errmsg4 = "Error in proof goal: "+        errmsg5 = "Proof not satisfied: "+        proofname = " (Proof "++show pn++")"+    in+        do  { let rs1 = map ssFindRuleset sns       :: [SwishStateIO (Either String RDFRuleset)]+            ; rs2 <- sequence rs1                   -- [Either String RDFRuleset]+            ; let erss = sequence rs2               :: Either String [RDFRuleset]+            ; eig <- igf                            -- Either String RDFFormula+            ; let st1  = sequence $ flist stfs erss :: SwishStateIO [Either String RDFProofStep]+            ; st2 <- st1                            -- [Either String RDFProofStep]+            ; let ests = sequence st2               :: Either String [RDFProofStep]+            ; erg  <- rgf                           -- Either String RDFFormula+            ; let proof = case (erss,eig,ests,erg) of+                    (Left er,_,_,_) -> Left (errmsg1++er++proofname)+                    (_,Left er,_,_) -> Left (errmsg2++er++proofname)+                    (_,_,Left er,_) -> Left (errmsg3++er++proofname)+                    (_,_,_,Left er) -> Left (errmsg4++er++proofname)+                    (Right rss, Right ig, Right sts, Right rg) ->+                        Right (makeRDFProof rss ig rg sts)+            ; when False $ case proof of+                    (Left  _)  -> return ()+                    (Right pr) -> putResourceData Nothing $+                                    (("Proof "++show pn++"\n")++)+                                    . showsProof "\n" pr+            ; let checkproof = case proof of+                    (Left  er) -> setError er+                    (Right pr) ->+                        case explainProof pr of+                            Nothing -> setInfo (infmsg1++show pn)+                            Just ex -> setError (errmsg5++show pn++", "++ex)+                        {-+                        if not $ checkProof pr then+                            setError (errmsg5++show pn)+                        else+                            setInfo (infmsg1++show pn)+                        -}+            ; modify 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 _  _    _   (Left  er)  = return $ Left er+ssCheckStep rn eagf ecgf (Right rss) =+    let+        errmsg1 = "Rule not in proof step ruleset(s): "+        errmsg2 = "Error in proof step antecedent graph(s): "+        errmsg3 = "Error in proof step consequent graph: "+    in+        do  { let mrul = getMaybeContextRule rn rss :: Maybe RDFRule+            ; esag <- sequence eagf                 -- [Either String RDFFormula]]+            ; let eags = sequence esag              :: Either String [RDFFormula]+            ; ecg  <- ecgf                          -- Either String RDFFormula+            ; let est = case (mrul,eags,ecg) of+                    (Nothing,_,_) -> Left (errmsg1++show rn)+                    (_,Left er,_) -> Left (errmsg2++er)+                    (_,_,Left er) -> Left (errmsg3++er)+                    (Just rul,Right ags,Right cg) ->+                        Right $ makeRDFProofStep rul ags cg+            ; return 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 sn rn agfs cn prefs =+    let+        errmsg1 = "FwdChain rule error: "+        errmsg2 = "FwdChain antecedent error: "+    in+        do  { erl  <- ssFindRulesetRule sn rn+            ; aesg <- sequence agfs     -- [Either String RDFGraph]+            ; let eags = sequence aesg   :: Either String [RDFGraph]+            ; let fcr = case (erl,eags) of+                    (Left er,_) -> setError (errmsg1++er)+                    (_,Left er) -> setError (errmsg2++er)+                    (Right rl,Right ags) ->+                        modGraphs (mapReplaceOrAdd (NamedGraph cn [cg]))+                        where+                            cg = case fwdApply rl ags of+                                []  -> emptyRDFGraph+                                grs -> setNamespaces prefs $ foldl1 add grs+            ; modify fcr+            }++ssFindRulesetRule ::+    ScopedName -> ScopedName -> SwishStateIO (Either String RDFRule)+ssFindRulesetRule sn rn = gets find+    where+        find st = case findRuleset sn st of+            Nothing -> Left ("Ruleset not found: "++show sn)+            Just rs -> find1 rs+        find1 rs = case getRulesetRule rn rs of+            Nothing -> Left ("Rule not in ruleset: "++show sn++": "++show rn)+            Just rl -> Right rl++ssFindRuleset ::+    ScopedName -> SwishStateIO (Either String RDFRuleset)+ssFindRuleset sn = gets find+    where+        find st = case findRuleset sn st of+            Nothing -> Left ("Ruleset not found: "++show sn)+            Just rs -> Right 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 sn rn cgf an prefs =+    let+        errmsg1 = "BwdChain rule error: "+        errmsg2 = "BwdChain goal error: "+    in+        do  { erl <- ssFindRulesetRule sn rn+            ; ecg <- cgf                -- Either String RDFGraph+            ; let fcr = case (erl,ecg) of+                    (Left er,_) -> setError (errmsg1++er)+                    (_,Left er) -> setError (errmsg2++er)+                    (Right rl,Right cg) ->+                        modGraphs (mapReplaceOrAdd (NamedGraph an ags))+                        where+                            ags  = map mergegr (bwdApply rl cg)+                            mergegr grs = case grs of+                                [] -> emptyRDFGraph+                                _  -> setNamespaces prefs $ foldl1 add grs+            ; modify fcr+            }++--  Temporary implementation:  just read local file WNH     +--  (Add logic to separate filenames from URIs, and+--  attempt HTTP GET, or similar.)+getResourceData :: Maybe String -> SwishStateIO (Either String String)+getResourceData muri =+    case muri of+        Nothing  -> fromStdin+        Just uri -> fromUri uri+    where+    fromStdin =+        do  { dat <- lift getContents+            ; return $ Right dat+            }+    fromUri = fromFile+    fromFile uri =+        do  { dat <- lift $ readFile uri+            ; return $ Right dat+            }++--  Temporary implementation:  just write local file+--  (Need to add logic to separate filenames from URIs, and+--  attempt HTTP PUT, or similar.)+putResourceData :: Maybe String -> ShowS -> SwishStateIO ()+putResourceData muri gsh =+    do  { ios <- lift $ IO.try $+            case muri of+                Nothing  -> toStdout+                Just uri -> toUri uri+        ; case ios of+            Left  ioe -> modify $ setError+                            ("Error writing graph: "+++                             IO.ioeGetErrorString ioe)+            Right a   -> return a+        }+    where+        toStdout  = putStrLn gstr+        toUri uri = writeFile uri gstr+        gstr = gsh ""++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/VarBinding.hs view
@@ -0,0 +1,541 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  VarBinding+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  MultiParamTypeClasses, TypeSynonymInstances+--+--  This module defines functions for representing and manipulating query+--  binding variable sets.  This is the key data that mediates between+--  query and back substitution when performing inferences.  A framework+--  of query variable modifiers is provided that can be used to+--  implement richer inferences, such as filtering of  query results,+--  or replacing values based on known relationships.+--+--------------------------------------------------------------------------------++module Swish.RDF.VarBinding+    ( VarBinding(..), nullVarBinding+    , boundVars, subBinding, makeVarBinding+    , applyVarBinding, joinVarBindings, addVarBinding+    , VarBindingModify(..), OpenVarBindingModify+    , vbmCompatibility, vbmCompose+    , composeSequence, findCompositions, findComposition+    , VarBindingFilter(..)+    , makeVarFilterModify+    , makeVarTestFilter, makeVarCompareFilter+    , varBindingId, nullVarBindingModify+    , varFilterDisjunction, varFilterConjunction+    , varFilterEQ, varFilterNE+    )+where++import Swish.Utils.LookupMap+    ( LookupEntryClass(..) +    , makeLookupMap, mapFindMaybe+    )++import Swish.Utils.Namespace+    ( ScopedName(..) )++import Swish.RDF.Vocabulary+    ( swishName )++import Swish.Utils.ListHelpers+    ( equiv, subset, flist, headOrNothing, permutations )++import Data.Maybe+    ( mapMaybe, fromMaybe, isJust, fromJust, listToMaybe )++import Data.List+    ( find, intersect, union, (\\) )+++------------------------------------------------------------+--  Query variable bindings+------------------------------------------------------------++-- |VarBinding is the type of an arbitrary variable bindings+--  value, where the type of the bound values is not specified.+--+data VarBinding a b = VarBinding+    { vbMap  :: a -> Maybe b+    , vbEnum :: [(a,b)]+    , vbNull :: Bool+    }++-- |VarBinding is an instance of class Eq, so that variable+--  bindings can be compared for equivalence+--+instance (Eq a, Eq b) => Eq (VarBinding a b) where+    vb1 == vb2 = vbEnum vb1 `equiv` vbEnum vb2++-- |VarBinding is an instance of class Show, so that variable+--  bindings can be displayed+--+instance (Show a, Show b) => Show (VarBinding a b) where+    show = show . vbEnum++-- | maps no query variables.+--+nullVarBinding :: VarBinding a b+nullVarBinding = VarBinding+    { vbMap  = const Nothing+    , vbEnum = []+    , vbNull = True+    }++-- |Return a list of the variables bound by a supplied variable binding+--+boundVars :: VarBinding a b -> [a]+boundVars = map fst . vbEnum++-- |VarBinding subset function, tests to see if one query binding+--  is a subset of another;  i.e. every query variable mapping defined+--  by one is also defined by the other.+--+subBinding :: (Eq a, Eq b) => VarBinding a b -> VarBinding a b -> Bool+subBinding vb1 vb2 = vbEnum vb1 `subset` vbEnum vb2++-- |Function to make a variable binding from a list of+--  pairs of variable and corresponding assigned value.+--+makeVarBinding :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> VarBinding a b+makeVarBinding vrbs =+    if null vrbs then nullVarBinding -- (nullVarBinding :: VarBinding a b)+    else VarBinding+        { vbMap  = selectFrom vrbs+        , vbEnum = vrbs+        , vbNull = null vrbs+        }+    where+        selectFrom = flip mapFindMaybe . makeLookupMap+        --  selectFrom bs is the VarBinding lookup function+        {-+        selectFrom :: (Eq a) => [(a,b)] -> a -> Maybe b+        selectFrom []         _ = Nothing+        selectFrom ((v,r):bs) l = if l == v then Just r+                                    else selectFrom bs l+        -}++-- |Apply query binding to a supplied value, returning the value+--  unchanged if no binding is defined+--+applyVarBinding :: VarBinding a a -> a -> a+applyVarBinding vbind v = fromMaybe v (vbMap vbind v)++-- |Join a pair of query bindings, returning a new binding that+--  maps all variables recognized by either of the input bindings.+--  If the bindings should overlap, such overlap is not detected and+--  the value from the first binding provided is used arbitrarily.+--+joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b+joinVarBindings vb1 vb2+    | vbNull vb1 = vb2+    | vbNull vb2 = vb1+    | otherwise  = VarBinding+        { vbMap  = mv12+        , vbEnum = map (\v -> (v,fromJust (mv12 v))) bv12+        , vbNull = False+        }+    where+        -- flist fs a = map ($ a) fs;  see also monad function 'ap'+        mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]+        bv12 = boundVars vb1 `union` boundVars vb2++-- |Add a single new value to a variable binding and return the resulting+--  new variable binding.+--+addVarBinding :: (Eq a, Show a, Eq b, Show b) => a -> b -> VarBinding a b+    -> VarBinding a b+addVarBinding lb val vbind = joinVarBindings vbind $ makeVarBinding [(lb,val)]++------------------------------------------------------------+--  Datatypes for variable binding modifiers+------------------------------------------------------------++-- |Define the type of a function to modify variable bindings in+--  forward chaining based on rule antecedent matches.  This+--  function is used to implement the \"allocated to\" logic described+--  in Appendix B of the RDF semantics document, in which a specific+--  blank node is associated with all matches of some specific value+--  by applications of the rule on a given graph.+--  Use 'id' if no modification of the variable bindings is required.+--+--  This datatype consists of the modifier function itself, which+--  operates on a list of variable bindings rather than a single+--  variable binding (because some modifications share context across+--  a set of bindings), and some additional descriptive information+--  that allows possible usage patterns to be analyzed.+--+--  Some usage patterns (see 'vbmUsage' for more details):+--+--  [filter]  all variables are input variables, and the effect+--      of the modifier function is to drop variable bindings that+--      don't satisfy some criterion.+--      Identifiable by an empty element in @vbmUsage@.+--+--  [source]  all variables are output variables:  a raw query+--      could be viewed as a source of variable bindings.+--      Identifiable by an element of @vbmUsage@ equal to @vbmVocab@.+--+--  [modifier]  for each supplied variable binding, one or more+--      new variable bindings may be created that contain the+--      input variables bound as supplied plus some additional variables.+--      Identifiable by an element of @vbmUsage@ some subset of @vbmVocab@.+--+--  A variety of variable usage patterns may be supported by a given+--  modifier:  a modifier may be used to define new variable bindings+--  from existing bindings in a number of ways, or simply to check that+--  some required relationship between bindings is satisfied.+--  (Example, for @a + b = c@, any one variable can be deduced from the+--  other two, or all three may be supplied to check that the relationship+--  does indeed hold.)+--+data VarBindingModify a b = VarBindingModify+    { vbmName   :: ScopedName+                            -- ^Name used to identify this variable binding+                            --  modifier when building inference rules.+    , vbmApply  :: [VarBinding a b] -> [VarBinding a b]+                            -- ^Apply variable binding modifier to a+                            --  list of variable bindings, returning a+                            --  new list.  The result list is not+                            --  necessarily the same length as the+                            --  supplied list.+    , vbmVocab  :: [a]      -- ^List of variables used by this modifier.+                            --  All results of applying this modifier contain+                            --  bindings for these variables.+    , vbmUsage  :: [[a]]    -- ^List of binding modifier usage patterns+                            --  supported.  Each pattern is characterized as+                            --  a list of variables for which new bindings+                            --  may be created by some application of this+                            --  modifier, assuming that bindings for all other+                            --  variables in @vbmVocab@ are supplied.+    }++-- |Allow a VarBindingModify value to be accessed using a 'LookupMap'.+--+instance LookupEntryClass+    (VarBindingModify a b) ScopedName (VarBindingModify a b)+    where+        keyVal   vbm     = (vbmName vbm,vbm)+        newEntry (_,vbm) = vbm++-- |Type for variable binding modifier that has yet to be instantiated+--  with respect to the variables that it operates upon.+--+type OpenVarBindingModify lb vn = [lb] -> VarBindingModify lb vn++-- |Extract variable binding name from @OpenVarBindingModify@ value+--+--  (Because only the name is required, the application to an undefined+--  list of variable labels should never be evaluated, as long as the+--  name is not dependent on the variable names in any way.)+--+--  NOT QUITE... some of the functions that create @OpenVarBindingModify@+--  instances also pattern-match the number of labels provided, forcing+--  evaluation of the labels parameter, even though it's not used.+--+openVbmName :: OpenVarBindingModify lb vn -> ScopedName+openVbmName ovbm = vbmName (ovbm (error "Undefined labels in variable binding"))++-- |Allow an @OpenVarBindingModify@ value to be accessed using a @LookupMap@.+--+instance LookupEntryClass+    (OpenVarBindingModify a b) ScopedName (OpenVarBindingModify a b)+    where+        keyVal   ovbm     = (openVbmName ovbm,ovbm)+        newEntry (_,ovbm) = ovbm++-- |Allow an OpenVarBindingModify value to be accessed using a LookupMap.+--+instance Show (OpenVarBindingModify a b)+    where+        show = show . openVbmName++-- |Variable binding modifier compatibility test.+--+--  Given a list of bound variables and a variable binding modifier, return+--  a list of new variables that may be bound, or @Nothing@.+--+--  Note:  if the usage pattern component is well-formed (i.e. all+--  elements different) then at most one element can be compatible with+--  a given input variable set.+--+vbmCompatibility :: (Eq a) => VarBindingModify a b -> [a] -> Maybe [a]+vbmCompatibility vbm vars = find compat (vbmUsage vbm)+    where+        compat = vbmCompatibleVars vars (vbmVocab vbm)++-- |Variable binding usage compatibility test.+--+--  Returns @True@ if the supplied variable bindings can be compatibly+--  processed by a variable binding usage with supplied vocabulary and+--  usage pattern.+--+vbmCompatibleVars ::+  (Eq a) +  => [a] -- ^ variables supplied with bindings+  -> [a] -- ^ variables returned with bindings by a modifier+  -> [a] -- ^ variables assigned new bindings by a modifier+  -> Bool+vbmCompatibleVars bvars vocab ovars =+    null (ivars `intersect` ovars) &&       -- ivars and ovars don't overlap+    null ((vocab \\ ovars) \\ ivars)        -- ovars and ivars cover vocab+    where+        ivars = bvars `intersect` vocab++-- |Compose variable binding modifiers.+--+--  Returns @Just a@ new variable binding modifier that corresponds to+--  applying the first supplied modifier and then applying the second+--  one, or @Nothing@ if the two modifiers cannot be compatibly composed.+--+--  NOTE:  this function does not, in general, commute.+--+--  NOTE:  if there are different ways to achieve the same usage, that+--  usage is currently repeated in the result returned.+--+vbmCompose :: (Eq a) => VarBindingModify a b -> VarBindingModify a b+    -> Maybe (VarBindingModify a b)+vbmCompose+    (VarBindingModify nam1 app1 voc1 use1)+    (VarBindingModify nam2 app2 voc2 use2)+    | not (null use12) = Just VarBindingModify+        { vbmName  = swishName ("_"++ snLocal nam1 ++"_"++ snLocal nam2 ++"_")+        , vbmApply = app2 . app1+        , vbmVocab = voc1 `union` voc2+        , vbmUsage = use12+        }+    | otherwise = Nothing+    where+        use12 = compatibleUsage voc1 use1 use2++-- |Determine compatible ways in which variable binding modifiers may+--  be combined.+--+--  The total vocabulary of a modifier is the complete set of variables+--  that are used or bound by the modifier.  After the modifier has been+--  applied, bindings must exist for all of these variables.+--+--  A usage pattern of a modifier is a set of variables for which new+--  bindings may be generated by the modifier.+--+--  The only way in which two variable binding modifiers can be incompatible+--  with each other is when they both attempt to create a new binding for+--  the same variable.  (Note that this does not mean the composition will+--  be compatible with all inputs:  see 'vbmCompatibleVars'.)+--+--  NOTE:  if there are different ways to achieve the same usage, that+--  usage is currently repeated in the result returned.+--+compatibleUsage ::+  (Eq a)+  => [a]   -- ^ the total vocabulary of the first modifier to be applied+  -> [[a]] -- ^ usage patterns for the first modifier+  -> [[a]] -- ^ usage patterns for the second modifier+  -> [[a]] -- ^ a list of possible usage patterns for the composition of+           --  the first modifier with the second modifier, or an empty list if+           --  the modifiers are incompatible.+compatibleUsage voc1 use1 use2 =+    [ u1++u2 | u2 <- use2, null (voc1 `intersect` u2), u1 <- use1 ]++-- |Find all compatible compositions of a list of variable binding+--  modifiers for a given set of supplied bound variables.+findCompositions :: (Eq a) => [VarBindingModify a b] -> [a]+    -> [VarBindingModify a b]+findCompositions vbms vars =+    mapMaybe (composeCheckSequence vars) (permutations vbms)++-- |Compose sequence of variable binding modifiers, and check+--  that the result can be used compatibly with a supplied list+--  of bound variables, returning @Just (composed modifier)@,+--  or @Nothing@.+--+composeCheckSequence :: (Eq a) => [a] -> [VarBindingModify a b]+    -> Maybe (VarBindingModify a b)+composeCheckSequence vars vbms = useWith vars $ composeSequence vbms+    where+        --  Check that a Maybe modifier is compatible for use with an+        --  indicated set of bound variables, and return (Just modifier)+        --  or Nothing.+        useWith _    Nothing    = Nothing+        useWith vs v@(Just vbm)+            | isJust $ vbmCompatibility vbm vs = v+            | otherwise                        = Nothing++-- |Compose sequence of variable binding modifiers.+--+composeSequence :: (Eq a) => [VarBindingModify a b]+    -> Maybe (VarBindingModify a b)+composeSequence [] = Just varBindingId+composeSequence (vbm:vbms) =+    foldl composePair (Just vbm) vbms++-- |Compose a pair of variable binding modifiers, returning+--  @Just (composed modifier)@, or @Nothing@.+--+composePair :: (Eq a) => Maybe (VarBindingModify a b) -> VarBindingModify a b+    -> Maybe (VarBindingModify a b)+composePair Nothing     _    = Nothing+composePair (Just vbm1) vbm2 = vbmCompose vbm1 vbm2++-- |Return @Just a@ compatible composition of variable binding modifiers+--  for a given set of supplied bound variables, or @Nothing@ if there+--  is no compatible composition+--+findComposition :: (Eq a) => [VarBindingModify a b] -> [a]+    -> Maybe (VarBindingModify a b)+findComposition = listToMaybe `c2` findCompositions+    where+        c2 = (.) . (.)  -- compose with function of two arguments++-- |Variable binding modifier that returns exactly those+--  variable bindings presented.+--+varBindingId :: VarBindingModify a b+varBindingId = VarBindingModify+    { vbmName   = swishName "varBindingId"+    , vbmApply  = id+    , vbmVocab  = []+    , vbmUsage  = [[]]+    }++-- |Null variable binding modifier+--+--  This is like 'varBindingId' except parameterized by some labels.+--  I think this is redundant, and should be eliminated.+--+nullVarBindingModify :: OpenVarBindingModify a b+nullVarBindingModify lbs = VarBindingModify+    { vbmName   = swishName "nullVarBindingModify"+    , vbmApply  = id+    , vbmVocab  = lbs+    , vbmUsage  = [[]]+    }++------------------------------------------------------------+--  Query binding filters+------------------------------------------------------------++-- |VarBindingFilter is a function type that tests to see if+--  a query binding satisfies some criterion.+--+--  Queries often want to apply some kind of filter or condition+--  to the variable bindings that are processed.  In inference rules,+--  it sometimes seems desirable to stipulate additional conditions on+--  the things that are matched.+--+--  This function type is used to perform such tests.+--  A number of simple implementations are included below.+data VarBindingFilter a b = VarBindingFilter+    { vbfName   :: ScopedName+    , vbfVocab  :: [a]+    , vbfTest   :: VarBinding a b -> Bool+    }++-- |Make a variable binding modifier from a variable binding filter value.+makeVarFilterModify :: VarBindingFilter a b -> VarBindingModify a b+makeVarFilterModify vbf = VarBindingModify+    { vbmName   = vbfName vbf+    , vbmApply  = filter (vbfTest vbf)+    , vbmVocab  = vbfVocab vbf+    , vbmUsage  = [[]]+    }++-- |Make a variable test filter for a named variable using a+--  supplied value testing function.+makeVarTestFilter ::+    ScopedName -> (b -> Bool) -> a -> VarBindingFilter a b+makeVarTestFilter nam vtest var = VarBindingFilter+    { vbfName   = nam+    , vbfVocab  = [var]+    , vbfTest   = \vb -> case vbMap vb var of+                    Just val  -> vtest val+                    _         -> False+    }++-- |Make a variable comparison filter for named variables using+--  a supplied value comparison function.+makeVarCompareFilter ::+    ScopedName -> (b -> b -> Bool) -> a -> a -> VarBindingFilter a b+makeVarCompareFilter nam vcomp v1 v2 = VarBindingFilter+    { vbfName   = nam+    , vbfVocab  = [v1,v2]+    , vbfTest   = \vb -> case (vbMap vb v1,vbMap vb v2) of+                    (Just val1, Just val2) -> vcomp val1 val2+                    _                      -> False+    }++------------------------------------------------------------+--  Declare some generally useful query binding filters+------------------------------------------------------------++-- |This function generates a query binding filter that ensures that+--  two indicated query variables are mapped to the same value.+varFilterEQ :: (Eq b) => a -> a -> VarBindingFilter a b+varFilterEQ =+    makeVarCompareFilter (swishName "varFilterEQ") (==) ++-- |This function generates a query binding filter that ensures that+--  two indicated query variables are mapped to different values.+varFilterNE :: (Eq b) => a -> a -> VarBindingFilter a b+varFilterNE =+    makeVarCompareFilter (swishName "varFilterNE") (/=) ++-- |This function composes a number of query binding filters+--  into a composite filter that accepts any query binding that+--  satisfies at least one of the component values.+varFilterDisjunction :: (Eq a) => [VarBindingFilter a b]+    -> VarBindingFilter a b+varFilterDisjunction vbfs = VarBindingFilter+    { vbfName   = swishName "varFilterDisjunction"+    , vbfVocab  = foldl1 union (map vbfVocab vbfs)+    , vbfTest   = or . flist (map vbfTest vbfs)+    }++-- |This function composes a number of query binding filters+--  into a composite filter that accepts any query binding that+--  satisfies all of the component values.+--+--  The same function could be achieved by composing the component+--  filter-based modifiers, but this function is more convenient+--  as it avoids the need to check for modifier compatibility.+--+varFilterConjunction :: (Eq a) => [VarBindingFilter a b]+    -> VarBindingFilter a b+varFilterConjunction vbfs = VarBindingFilter+    { vbfName   = swishName "varFilterConjunction"+    , vbfVocab  = foldl1 union (map vbfVocab vbfs)+    , vbfTest   = and . flist (map vbfTest vbfs)+    }++--------------------------------------------------------------------------------+--+--  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/RDF/Vocabulary.hs view
@@ -0,0 +1,264 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Vocabulary+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines some commonly used vocabulary terms,+--  using the 'Namespace' and 'ScopedName' data types.+--+--------------------------------------------------------------------------------++module Swish.RDF.Vocabulary+    ( namespaceNull+    , namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , namespaceOWL+    , namespaceXSD+    , namespaceXsdType+    , namespaceMATH+    , namespaceLOG+    , namespaceDAML+    , namespaceDefault+    , namespaceSwish, swishName+    , namespaceLang,  langName, langTag, isLang+    , scopeRDF+    , scopeRDFS+    , scopeRDFD+    , rdf_datatype, rdf_resource, rdf_about, rdf_ID+    , rdf_type+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral+    , rdfs_member+    , rdfd_GeneralRestriction+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality+    , owl_sameAs, log_implies+    , xsd_type, xsd_string, xsd_boolean+    , xsd_decimal, xsd_integer+    , xsd_nonneg_integer, xsd_nonpos_integer, xsd_pos_integer, xsd_neg_integer+    , xsd_float, xsd_double+    , default_base+    )+where++import Swish.Utils.Namespace+    ( Namespace(..), ScopedName(..) )++import Swish.Utils.MiscHelpers+    ( lower )++------------------------------------------------------------+--  Define some common namespace values+------------------------------------------------------------++namespaceNull :: Namespace+namespaceNull+    = Namespace "" ""++namespaceRDF :: Namespace+namespaceRDF    =+    Namespace   "rdf"   "http://www.w3.org/1999/02/22-rdf-syntax-ns#"++namespaceRDFS :: Namespace+namespaceRDFS   =+    Namespace   "rdfs"  "http://www.w3.org/2000/01/rdf-schema#"++namespaceRDFD :: Namespace+namespaceRDFD   =+    Namespace   "rdfd"  "http://id.ninebynine.org/2003/rdfext/rdfd#"++namespaceOWL :: Namespace+namespaceOWL    =+    Namespace   "owl"   "http://www.w3.org/2002/07/owl#"++namespaceXSD :: Namespace+namespaceXSD    =+    Namespace   "xsd"   "http://www.w3.org/2001/XMLSchema#"++namespaceXsdType :: String -> Namespace+namespaceXsdType dtname =+    Namespace   ("xsd_"++dtname)+                ("http://id.ninebynine.org/2003/XMLSchema/"++dtname++"#")++namespaceMATH :: Namespace+namespaceMATH   =+    Namespace   "math"  "http://www.w3.org/2000/10/swap/math#"++namespaceLOG :: Namespace+namespaceLOG    =+    Namespace   "log"   "http://www.w3.org/2000/10/swap/log#"+    -- Namespace   "log"   "http://www.w3.org/2000/10/swap/log.n3#"++namespaceDAML :: Namespace+namespaceDAML   =+    Namespace   "daml"  "http://www.daml.org/2000/10/daml-ont#"++namespaceDefault :: Namespace+namespaceDefault+    -- = Namespace "default" "#"+    = Namespace "default" "http://id.ninebynine.org/default/"++namespaceSwish :: Namespace+namespaceSwish+    = Namespace "swish" "http://id.ninebynine.org/2003/Swish/"++swishName :: String -> ScopedName+swishName = ScopedName namespaceSwish++-----------------------------------------------------------+--  Language tags+------------------------------------------------------------+--+--  Note:  simple language tag URIs may be abbreviated as lang:tag,+--  but if the tag contains ahyphen, this would not be valid QName+--  form in Notation3, even though it is a valid QName component.+--  Fortunately, they do not currently need to appear in Notation3 as+--  distinct labels (but future developments m,ay change that).++namespaceLang :: Namespace+namespaceLang+    = Namespace "lang" "http://id.ninebynine.org/2003/Swish/Lang/"+    -- To be replaced by urn:ietf:params:lang?++langName :: String -> ScopedName+langName tag = ScopedName namespaceLang (lower tag)++langTag :: ScopedName -> String+langTag = snLocal++isLang :: ScopedName -> Bool+isLang sname = snScope sname == namespaceLang++------------------------------------------------------------+--  Define namespaces for RDF rules, axioms, etc+------------------------------------------------------------++scopeRDF :: Namespace+scopeRDF        =+    Namespace   "rs_rdf"   "http://id.ninebynine.org/2003/Ruleset/rdf#"++scopeRDFS :: Namespace+scopeRDFS       =+    Namespace   "rs_rdfs"  "http://id.ninebynine.org/2003/Ruleset/rdfs#"++scopeRDFD :: Namespace+scopeRDFD       =+    Namespace   "rs_rdfd"  "http://id.ninebynine.org/2003/Ruleset/rdfd#"++------------------------------------------------------------+--  Define some common vocabulary terms+------------------------------------------------------------++rdf_datatype            :: ScopedName+rdf_datatype            = ScopedName namespaceRDF  "datatype"++rdf_resource            :: ScopedName+rdf_resource            = ScopedName namespaceRDF  "resource"++rdf_about               :: ScopedName+rdf_about               = ScopedName namespaceRDF  "about"++rdf_ID                  :: ScopedName+rdf_ID                  = ScopedName namespaceRDF  "ID"++rdf_type                :: ScopedName+rdf_type                = ScopedName namespaceRDF  "type"++rdf_first               :: ScopedName+rdf_first               = ScopedName namespaceRDF  "first"++rdf_rest                :: ScopedName+rdf_rest                = ScopedName namespaceRDF  "rest"++rdf_nil                 :: ScopedName+rdf_nil                 = ScopedName namespaceRDF  "nil"++rdf_XMLLiteral          :: ScopedName+rdf_XMLLiteral          = ScopedName namespaceRDF  "XMLLiteral"++rdfs_member             :: ScopedName+rdfs_member             = ScopedName namespaceRDFS "member"++rdfd_GeneralRestriction :: ScopedName+rdfd_GeneralRestriction = ScopedName namespaceRDFD "GeneralRestriction"++rdfd_onProperties       :: ScopedName+rdfd_onProperties       = ScopedName namespaceRDFD "onProperties"++rdfd_constraint         :: ScopedName+rdfd_constraint         = ScopedName namespaceRDFD "constraint"++rdfd_maxCardinality     :: ScopedName+rdfd_maxCardinality     = ScopedName namespaceRDFD "maxCardinality"++xsd_type                :: String -> ScopedName+xsd_type                = ScopedName namespaceXSD++xsd_string              :: ScopedName+xsd_string              = xsd_type "string"++xsd_boolean             :: ScopedName+xsd_boolean             = xsd_type "boolean"++xsd_decimal             :: ScopedName+xsd_decimal             = xsd_type "decimal"++xsd_integer             :: ScopedName+xsd_integer             = xsd_type "integer"++xsd_nonneg_integer      :: ScopedName+xsd_nonneg_integer      = xsd_type "nonNegativeInteger"++xsd_nonpos_integer      :: ScopedName+xsd_nonpos_integer      = xsd_type "nonPositiveInteger"++xsd_pos_integer         :: ScopedName+xsd_pos_integer         = xsd_type "positiveInteger"++xsd_neg_integer         :: ScopedName+xsd_neg_integer         = xsd_type "negativeInteger"++xsd_float               :: ScopedName+xsd_float               = xsd_type "float"++xsd_double              :: ScopedName+xsd_double              = xsd_type "double"++owl_sameAs              :: ScopedName+owl_sameAs              = ScopedName namespaceOWL  "sameAs"++log_implies             :: ScopedName+log_implies             = ScopedName namespaceLOG "implies"++default_base            :: ScopedName+default_base            = ScopedName namespaceDefault "base"++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/DateTime.hs view
@@ -0,0 +1,325 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  DateTime+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module defines a collection of date/time manipulation functions. It+--  should probably be replaced by standard modules from Hackage. +--+--  Date/time value manipulation.+--+--  Date/time can be date-only or time-only+--+--  type DateTime is an instance of built-in classes Eq and Show+--+--  type DateTime has a constructor that accepts a string in the format+--      defined by RFC 3339.+--      Timezone interpretation is per RFC3339.+--+--------------------------------------------------------------------------------+--+--            year,month,day,hour,min,sec,millisec,timezone+--class (Show a,Eq a) => DateTimeClass a where+--  newDateTime  :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> a+--  toString     :: a -> String+--  size         :: a -> Int+--  toDateTime   :: String -> a+--  toDate       :: String -> a+--  toTime       :: String -> a+--  (==)         :: a -> a -> Bool   -- same date/time+--  (<)        :: a -> a -> Bool   -- first precedes second+--  (+)        :: a -> a -> a  -- advance by time+--  (-)        :: a -> a -> a  -- difference between times+--  dtShow     :: a -> String             -- return string form+--  dtYear       :: a -> Int+--  dtMonth      :: a -> Int+--  dtDay        :: a -> Int+--  dtHour       :: a -> Int+--  dtMinute     :: a -> Int+--  dtSecond     :: a -> Int+--  dtMillisecs  :: a -> Int+--  dtTimezone   :: a -> Int                -- time zone offset in minutes+--+--------------------------------------------------------------------------------++module Swish.Utils.DateTime where++data DateTime+  = DateTime Int Int Int Int Int Int Int Int++instance Eq DateTime where+  d1 == d2 = simpleEq ( normTZ d1 ) ( normTZ d2 )++instance Show DateTime where+  show = dtShow++instance Ord DateTime where+  dt1 <  dt2  = simpleLT ( normTZ dt1 ) ( normTZ dt2 )+  dt1 >  dt2  = dt2 < dt1+  dt1 <= dt2  = (dt1 < dt2)||(dt1==dt2)+  dt1 >= dt2  = (dt2 < dt1)||(dt1==dt2)++leapYear :: Int -> Bool+leapYear year+  | ( year `mod` 4 == 0 ) &&+    not ( ( year `mod` 100 == 0 ) &&+          ( (year `mod` 400) /= 0 ) ) = True+  | otherwise                         = False++daysInMonth :: Int -> Int -> Int+daysInMonth month year+  | month==1   = 31  --Jan+  | month==2   = if leapYear year then 29 else 28 --Feb+  | month==3   = 31  --Mar+  | month==4   = 30  --Apr+  | month==5   = 31  --May+  | month==6   = 30  --Jun+  | month==7   = 31  --Jul+  | month==8   = 31  --Aug+  | month==9   = 30  --Sep+  | month==10  = 31  --Oct+  | month==11  = 30  --Nov+  | month==12  = 31  --Dec+  | otherwise  = 0++validJulianDate :: Int -> Int -> Int -> Bool+validJulianDate yr mo da+  | yr < 1900              = False+  | mo > 12                = False+  | da > daysInMonth mo yr = False+  | otherwise              = True++toJulianDate1 :: DateTime -> Int+toJulianDate1 (DateTime y m d _ _ _ _ _) = toJulianDate y m d++toJulianDate :: Int -> Int -> Int -> Int+toJulianDate year month day+--  | not (validJulianDate year month day) = -1+  | year==1900 && month<=2               = if month==2 then day + 30 else day - 1+  | month>=3                             = toJD1 (year-1900) (month-3) day+  | otherwise                            = toJD1 (year-1901) (month+9) day+  where+    toJD1 :: Int -> Int -> Int -> Int+    toJD1 y m d+      = ( (1461*y) `div` 4 ) -+        (y `div` 100) ++        ((y+300) `div` 400) ++        ( ( (153*m) + 2 ) `div` 5 ) ++        d + 58++fromJulianDate:: Int -> DateTime+fromJulianDate jdate+  | jdate <= 58 = fromJD1 jdate+  | otherwise   = fromJD2 jdate+  where+    fromJD1 :: Int -> DateTime+    fromJD1 j+      | j<=30     = DateTime 1900 1 (j+1 ) 0 0 0 0 0+      | otherwise = DateTime 1900 2 (j-30) 0 0 0 0 0++    fromJD2 :: Int -> DateTime+    fromJD2 j+      = DateTime y2 m2 d1 0 0 0 0 0+      where+--          t1 = (400*(j+((j+36467)`div`36525)-((j+109517)`div`dc))) - 23638 -- 1/400-days from 1900-02-28 [t]+          t1 = (400*+                    (j+               +((4*(j+36465))`div`146097)+                  -((j+109513)`div`146097))) - 23638 -- 1/400-days from 1900-02-28 [t]+          dc = 146100                                -- days in cycle period (400 years) = 1/400-days in year+          t2 = ( ( t1 `mod` dc ) `div` 400 )*5 + 2   -- fifth-days into year, +2                      [j3]+          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)               [d]+          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11                         [j4]+          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12              [m]+          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28+          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around+          -- 36525  = days/century, not counting century adjustments+          -- 109517 = 146100 * (1900-1600)/400 - 58+          -- 23238  = 58*400 + 38  ???   38=152/4 ??++{-          -- this code works for dates before 2100 only+          t1 = (4*j) - 233                           -- quarter-days from 1900-02-28+          dc = 1461                                  -- days in cycle period (4 years) = quarter-days in year+          t2 = ( ( t1 `mod` dc ) `div` 4 )*5 + 2     -- fifth-days into year, +2+          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)+          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11+          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12+          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28+          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around+-}++date :: Int -> Int -> Int -> DateTime+date y m d = DateTime y m d 0 0 0 0 0++time :: Int -> Int -> Int -> Int -> Int -> DateTime+time = DateTime 0 0 0++dtYear       :: DateTime -> Int+dtMonth      :: DateTime -> Int+dtDay        :: DateTime -> Int+dtHour       :: DateTime -> Int+dtMinute     :: DateTime -> Int+dtSecond     :: DateTime -> Int+dtMillisecs  :: DateTime -> Int+dtTimezone   :: DateTime -> Int                -- time zone offset in minutes+dtYear      ( DateTime x _ _ _ _ _ _ _ ) = x+dtMonth     ( DateTime _ x _ _ _ _ _ _ ) = x+dtDay       ( DateTime _ _ x _ _ _ _ _ ) = x+dtHour      ( DateTime _ _ _ x _ _ _ _ ) = x+dtMinute    ( DateTime _ _ _ _ x _ _ _ ) = x+dtSecond    ( DateTime _ _ _ _ _ x _ _ ) = x+dtMillisecs ( DateTime _ _ _ _ _ _ x _ ) = x+dtTimezone  ( DateTime _ _ _ _ _ _ _ x ) = x++lenFix     :: String -> Int -> String+lenFix inStr newLen+  | length inStr >= newLen  = inStr+  | otherwise               = lenFix ('0':inStr) newLen++showTZ     :: Int -> String+showTZ tz+  | tz<0         = '-' : showTZabs (-tz)+  | tz==0        = showTZabs tz+  | otherwise    = '+' : showTZabs tz++showTZabs  :: Int -> String+showTZabs tz+  | tz==0        = "Z"+  | otherwise    = lenFix ( show ( tz `div` 60 ) ) 2 ++  ":" +++                   lenFix ( show ( tz `mod` 60 ) ) 2++showTime :: DateTime -> String+showTime ( DateTime _ _ _ hr mi se ms _ )+  | ms==0     = lenFix ( show hr ) 2 ++  ":" +++                lenFix ( show mi ) 2 ++  ":" +++                lenFix ( show se ) 2+  | otherwise = lenFix ( show hr ) 2 ++ ":" +++                lenFix ( show mi ) 2 ++ ":" +++                lenFix ( show se ) 2 ++ "." +++                lenFix ( show ms ) 3++showDate :: DateTime -> String+showDate ( DateTime yr mo da _ _ _ _ _ )+  = lenFix ( show yr ) 4 ++ "-" +++    lenFix ( show mo ) 2 ++ "-" +++    lenFix ( show da ) 2++dtShow     :: DateTime -> String             -- return string form+dtShow ( DateTime yr mo da hr mi se ms tz )+  = showDate ( DateTime yr mo da hr mi se ms tz ) ++ "T" +++    showTime ( DateTime yr mo da hr mi se ms tz ) ++ showTZ tz++carryMins :: DateTime -> DateTime+carryMins ( DateTime yr mo da hr mi se ms tz )+  | newhrs >= 24 = carryHours ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )+  | otherwise    = DateTime yr mo da newhrs (mi`mod`60) se ms tz+  where+    newhrs = hr + (mi`div`60)++carryHours :: DateTime -> DateTime+carryHours ( DateTime yr mo da hr mi se ms tz )+  = DateTime y m d (hr`mod`24) mi se ms tz+  where+    (DateTime y m d _ _ _ _ _) = fromJulianDate (toJulianDate yr mo da + (hr`div`24))++normTZ :: DateTime -> DateTime+normTZ ( DateTime yr mo da hr mi se ms tz )+  = carryMins ( DateTime yr mo da hr (mi-tz) se ms 0 )+--  = addMinutes (-tz) ( DateTime yr mo da hr mi se ms tz )++{- another way -}++addMilliSecs :: Int -> DateTime -> DateTime+addMilliSecs addms ( DateTime yr mo da hr mi se ms tz )+    | totms < 1000 = DateTime yr mo da hr mi se totms tz+    | otherwise    = addSeconds addse ( DateTime yr mo da hr mi se newms tz )+    where+        totms = ms + addms+        newms = totms `mod` 1000+        addse = totms `div` 1000++addSeconds :: Int -> DateTime -> DateTime+addSeconds addse ( DateTime yr mo da hr mi se ms tz )+    | totse < 60 = DateTime yr mo da hr mi totse ms tz+    | otherwise  = addMinutes addmi ( DateTime yr mo da hr mi newse ms tz )+    where+        totse = se + addse+        newse = totse `mod` 60+        addmi = totse `div` 60++addMinutes :: Int -> DateTime -> DateTime+addMinutes addmi ( DateTime yr mo da hr mi se ms tz )+    | totmi < 60 = DateTime yr mo da hr totmi se ms tz+    | otherwise  = addHours addhr ( DateTime yr mo da hr newmi se ms tz )+    where+        totmi = mi + addmi+        newmi = totmi `mod` 60+        addhr = totmi `div` 60++addHours :: Int -> DateTime -> DateTime+addHours addhr ( DateTime yr mo da hr mi se ms tz )+    | tothr < 24 = DateTime yr mo da tothr mi se ms tz+    | otherwise  = addDays addda ( DateTime yr mo da newhr mi se ms tz )+    where+        tothr = hr + addhr+        newhr = tothr `mod` 24+        addda = tothr `div` 24++addDays :: Int -> DateTime -> DateTime+addDays addda ( DateTime yr mo da hr mi se ms tz )+    = DateTime newyr newmo newda hr mi se ms tz+    where+        -- newdate = fromJulianDate (toJulianDate yr mo (da+addda) )+        -- newyr   = dtYear newdate+        -- newmo   = dtMonth newdate+        -- newda   = dtDay newdate+        DateTime newyr newmo newda _ _ _ _ _ = fromJulianDate ( toJulianDate yr mo da + addda )++{- another way -}++simpleEq :: DateTime -> DateTime -> Bool+--simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) == ( yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) )+simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) =+  ( yr1 == yr2 ) && ( mo1 == mo2 ) && ( da1 == da2 ) && ( hr1 == hr2 ) && ( mi1 == mi2 ) && ( se1 == se2 ) && ( ms1 == ms2 ) && ( tz1 == tz2 )++simpleLT :: DateTime -> DateTime -> Bool+simpleLT ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 _ ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 _ )+  | yr1 < yr2  = True+  | (yr1==yr2)&&(mo1<mo2) = True+  | (yr1==yr2)&&(mo1==mo2)&&(da1<da2) = True+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1<hr2) = True+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1<mi2) = True+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1<se2) = True+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1==se2)&&(ms1<ms2) = True+  | otherwise = False++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/ListHelpers.hs view
@@ -0,0 +1,431 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  ListHelpers+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines some generic list and related helper functions.+--+--------------------------------------------------------------------------------++module Swish.Utils.ListHelpers+      ( select, mapset, deleteIndex+      , subset, equiv, hasPartitions, addSetElem+      , headOrNothing+      , pairUngroup, pairsUngroup, pairSort, pairGroup+      , breakAll+      , powerSet, combinations+      , permutations, listProduct+      , powerSequences, powerSequences_len, powerSequences_inf+      , flist, ffold, allf, anyf, allp, anyp )+where++import Data.Ord (comparing)  +import Data.List (union, intersect, sortBy, groupBy)++------------------------------------------------------------+--  Generic helpers+------------------------------------------------------------++-- |Select is like filter, except that it tests one list to select+--  elements from a second list.+select :: ( a -> Bool ) -> [a] -> [b] -> [b]+select _ [] []           = []+select f (e1:l1) (e2:l2)+    | f e1      = e2 : select f l1 l2+    | otherwise = select f l1 l2+select _ _ _    = error "select supplied with different length lists"++-- |Collect set of values from list under supplied mapping function+mapset :: Eq b => ( a -> b ) -> [a] -> [b]+mapset _ []    = []+mapset f (e:l) = [f e] `union` mapset f l++-- |Delete the n'th element of a list, returning the result+--+--  If the list doesn't have an n'th element, return the list unchanged.+--+deleteIndex :: [a] -> Int -> [a]+deleteIndex [] _ = []+deleteIndex xxs@(x:xs) n+    | n <  0    = xxs+    | n == 0    = xs+    | otherwise = x:deleteIndex xs (n-1)++{-+testdi1 = deleteIndex [1,2,3,4] 0    == [2,3,4]+testdi2 = deleteIndex [1,2,3,4] 1    == [1,3,4]+testdi3 = deleteIndex [1,2,3,4] 2    == [1,2,4]+testdi4 = deleteIndex [1,2,3,4] 3    == [1,2,3]+testdi5 = deleteIndex [1,2,3,4] 4    == [1,2,3,4]+testdi6 = deleteIndex [1,2,3,4] (-1) == [1,2,3,4]+testdi = and+    [ testdi1, testdi2, testdi3, testdi4, testdi5, testdi6 ]+-}++------------------------------------------------------------+--  Set functions+------------------------------------------------------------++-- |Subset test++subset          :: (Eq a) => [a] -> [a] -> Bool+a `subset` b    = and [ ma `elem` b | ma <- a ]++-- |Set equivalence test++equiv           :: (Eq a) => [a] -> [a] -> Bool+a `equiv` b     = a `subset` b && b `subset` a++-- |Set partition test+--+--  Is it possible to be more efficient here?+--  Maybe something like sort\/merge\/compare?+hasPartitions   :: (Eq a) => [a] -> ([a],[a]) -> Bool+a `hasPartitions` (b1,b2) =+    null (b1 `intersect` b2) && (a `equiv` (b1 `union` b2))++-- |Add element to set++addSetElem :: (Eq a) => a -> [a] -> [a]+addSetElem e es = if e `elem` es then es else e:es++------------------------------------------------------------+--  Lists and Maybes+------------------------------------------------------------++-- |Return head of a list of @Maybe@'s, or @Nothing@ if list is empty+--+--  Use with @filter isJust@ to select a non-Nothing value from a+--  list when such a value is present.+--+headOrNothing :: [Maybe a] -> Maybe a+headOrNothing []    = Nothing+headOrNothing (a:_) = a++------------------------------------------------------------+--  Filter, ungroup, sort and group pairs by first member+------------------------------------------------------------++{-+pairSelect :: ((a,b) -> Bool) -> ((a,b) -> c) -> [(a,b)] -> [c]+pairSelect p f as = map f (filter p as)+-}++pairUngroup :: (a,[b]) -> [(a,b)]+pairUngroup (a,bs) = [ (a,b) | b <- bs ]++pairsUngroup :: [(a,[b])] -> [(a,b)]+pairsUngroup ps = [ (a,b) | (a,bs) <- ps, b <- bs ]++pairSort :: (Ord a) => [(a,b)] -> [(a,b)]+pairSort = sortBy (comparing fst)++pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])]+pairGroup = map (factor . unzip) . groupBy eqFirst . pairSort +    where+      -- as is not [] by construction, but would be nice to have+      -- this enforced by the types+      factor (as, bs) = (head as,bs)+      eqFirst a b     = fst a == fst b++------------------------------------------------------------+--  Separate list into sublists+------------------------------------------------------------++-- |Break list into a list of sublists, separated by element+--  satisfying supplied condition.+breakAll :: (a -> Bool) -> [a] -> [[a]]+breakAll _ [] = []+breakAll p s  = let (h,s') = break p s+                    in h : breakAll p (drop 1 s')++------------------------------------------------------------+--  Powerset+------------------------------------------------------------++--  [[[TBD... there's a much better implementation in my email,+--     from Christopher Hendrie.  This is the raw code.]]]+{-+>ranked_powerset :: [a] -> [[[a]]]+>ranked_powerset = takeWhile (not . null) . foldr next_powerset ([[]] :+repeat [])+>+>next_powerset :: a -> [[[a]]] -> [[[a]]]+>next_powerset x r = zipWith (++) ([] : map (map (x:)) r) r+>+>powerset :: [a] -> [[a]]+>powerset = tail . concat . ranked_powerset+-}++-- |Powerset of a list, in ascending order of size.+--  Assumes the supplied list has no duplicate elements.+powerSet :: [a] -> [[a]]+powerSet as =+    concatMap (`combinations` as) [1..length as]++-- |Combinations of n elements from a list, each being returned in the+--  order that they appear in the list.+combinations :: Int -> [a] -> [[a]]+combinations _ []       = []        -- Don't include empty combinations+combinations n as@(ah:at)+    | n <= 0            = [[]]+    | n >  length as    = []+    | n == length as    = [as]+    | otherwise         = map (ah:) (combinations (n-1) at) +++                          combinations n at++{-+-- |Return list of integers from lo to hi.+intRange :: Int -> Int -> [Int]+intRange lo hi = take (hi-lo+1) (iterate (+1) 1)+-}++{-+-- Tests+testcomb0 = combinations 0 "abcd" -- []+testcomb1 = combinations 1 "abcd" -- ["a","b","c","d"]+testcomb2 = combinations 2 "abcd" -- ["ab","ac","ad","bc","bd","cd"]+testcomb3 = combinations 3 "abcd" -- ["abc","abd","acd","bcd"]+testcomb4 = combinations 4 "abcd" -- ["abcd"]+testcomb5 = combinations 5 "abcd" -- []+testpower = powerSet "abc"        -- ["a","b","c","ab","ac","bc","abc"]+-}++------------------------------------------------------------+--  Permutations of a list+------------------------------------------------------------++--  This algorithm is copied from an email by S.D.Mechveliani+--  http://www.dcs.gla.ac.uk/mail-www/haskell/msg01936.html+permutations :: [a] -> [[a]]+permutations    []     = [[]]+permutations    (j:js) = addOne $ permutations js+    where+        addOne = foldr ((++) . ao) []++        ao []           = [[j]]+        ao (k:ks)       = (j:k:ks) : map (k:) (ao ks)++{-+testperm = permutations [1,2,3] ==+    [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]+-}++------------------------------------------------------------+--  List product+------------------------------------------------------------++-- |Given a list of lists, construct a new list of lists where+--  each member of the new list is the same length as the original+--  list, and each member corresponds to a different choice of+--  one element from each of the original members in the+--  corresponding position.  Thus:+--+--  > listProduct [[a1,a2],[b1],[c1,c2]] =+--  >      [ [a1,b1,c1], [a1,b1,c2], [a2,b1,c1], [a2,b1,c2] ]+--+--  Note:  The length of the resulting list is the prodicty of+--  lengths of the components of the original list.  Thus, if+--  any member of the original list is empty then so is the+--  resulting list:+--+--  > listProduct [[a1,a2],[],[c1,c2]] = []+--+--  NOTE:  this is subsumed by 'sequence'+--+listProduct :: [[a]] -> [[a]]+listProduct []       = [[]]+listProduct (as:ass) = concat [ map (a:) (listProduct ass) | a <- as ]++{-+test1 = listProduct [["a1","a2"],["b1"],["c1","c2"]]+test2 = listProduct [["a1","a2"],[],["c1","c2"]]++lp []       = [[]]+lp (as:ass) = concatMap (\a -> (map (a:) (lp ass))) as+-}++------------------------------------------------------------+--  Powersequence (?) -- all sequences from some base values+------------------------------------------------------------++-- |Function to choose all sequences of any length+--  from a supplied set of values, returned in+--  increasing length.+powerSequences :: [a] -> [[a]]+powerSequences rs = concat $ powerSeq_bylen rs [[]]++-- |Construct list of lists of sequences of increasing length+powerSeq_bylen :: [a] -> [[a]] -> [[[a]]]+powerSeq_bylen rs ps = ps : powerSeq_bylen rs (powerSeq_next rs ps)++-- |Return sequences of length n+1 given original sequence+--  and list of all sequences of length n+powerSeq_next :: [a] -> [[a]] -> [[a]]+powerSeq_next rs rss = [ h:t | t <- rss, h <- rs ]++-- |Return all powersequences of a given length+powerSequences_len :: Int -> [a] -> [[a]]+powerSequences_len len rs = powerSeq_bylen rs [[]] !! len++-- |Return all powersequences of indefinite length+--  Observe that any such powersequence will consist of a sequence+--  of a finite length sequence followed by an indefinite number of+--  copies of the head of the base set.  To prevent duplicates, the+--  generator constructs only sequences that do not end in the first+--  member of the base set.+powerSequences_inf :: [a] -> [[a]]+powerSequences_inf rs =+    map (++pst) $ [] : concat (powerSeq_bylen rs psh)+    where+        psh = map (:[]) (tail rs)+        pst = repeat $ head rs++{- Powersequence tests+t0 = [1,2,3,4,5,6]+t1 = powerSequences t0+t2 = take 15 t1+t3 = powerSequences_len 3 t0+t4 = powerSequences_inf t0+t5 = map (take 6) $ take 15 t4+t6 = take 15 (powerSequences_len 6 t0)+t7 = t5 == t6+t8 = powerSequences_len1 3 t0+t9 = t8 == t3+-}++------------------------------------------------------------+--  Functions, lists and monads+------------------------------------------------------------++-- |Apply list of functions to some value, returning list of results.+--  It's kind of like an converse map.+--+--  This is similar to the 'ap' function in the Monad library.+--+flist :: [a->b] -> a -> [b]+flist fs a = map ($ a) fs++{-+flisttest = flist [(1*),(2*),(3*)] 5 -- [5,10,15]+-}++{-++-- |A more generalized form of flist that works with arbitrary Monads.+--  (Suggested by Derek Elkin.)++fmonad :: Monad m => m (a->b) -> a -> m b+fmonad fm a =+    do  { f <- fm+        ; return $ f a+        }++-}++{-+fmonadtest = fmonad [(1*),(2*),(3*)] 3 -- [3,6,9]+-}++-- |Fold result from list of functions applied to some value,+--  returning the result of the fold.+--+--  This is similar to the 'ap' function in the Monad library.+--+ffold :: (b->c->c) -> c -> [a->b] -> a -> c+ffold rf ri fs v = foldr rf ri (flist fs v)++{-+ffoldtest0 = ffold ge4and True [(1+),(2+),(3+)] 0     -- False+ffoldtest1 = ffold ge4and True [(1+),(2+),(3+)] 1     -- False+ffoldtest2 = ffold ge4and True [(1+),(2+),(3+)] 2     -- False+ffoldtest3 = ffold ge4and True [(1+),(2+),(3+)] 3     -- True+ge4and v b = (v>=4 && b)+ffoldtest  = and [not ffoldtest0,not ffoldtest1,not ffoldtest2,ffoldtest3]+-}++-- |Test if application of all functions in list to a given value+--  satisfies a given condition+--+allf :: (b->Bool)  -> [a->b] -> a -> Bool+allf pf fs a = all pf (flist fs a)++{-+allftest0 = allf (>=4) [(1+),(2+),(3+)] 0     -- False+allftest1 = allf (>=4) [(1+),(2+),(3+)] 1     -- False+allftest2 = allf (>=4) [(1+),(2+),(3+)] 2     -- False+allftest3 = allf (>=4) [(1+),(2+),(3+)] 3     -- True+allftest  = and [not allftest0,not allftest1,not allftest2,allftest3]+-}++-- |Test if application of any functions in list to a given value+--  satisfies a given condition+--+anyf :: (b->Bool)  -> [a->b] -> a -> Bool+anyf pf fs a = any pf (flist fs a)++{-+anyftest0 = anyf (>=4) [(1+),(2+),(3+)] 0     -- False+anyftest1 = anyf (>=4) [(1+),(2+),(3+)] 1     -- True+anyftest2 = anyf (>=4) [(1+),(2+),(3+)] 2     -- True+anyftest3 = anyf (>=4) [(1+),(2+),(3+)] 3     -- True+anyftest  = and [not anyftest0,anyftest1,anyftest2,anyftest3]+-}++-- |Test if a value satisfies all predicates in a list+--+allp :: [a->Bool] -> a -> Bool+allp ps a = and (flist ps a)++{-+allptest0 = allp [(>=1),(>=2),(>=3)] 0     -- False+allptest1 = allp [(>=1),(>=2),(>=3)] 1     -- False+allptest2 = allp [(>=1),(>=2),(>=3)] 2     -- False+allptest3 = allp [(>=1),(>=2),(>=3)] 3     -- True+allptest  = and [not allptest0,not allptest1,not allptest2,allptest3]+-}++-- |Test if a value satisfies any predicate in a list+--+anyp :: [a->Bool] -> a -> Bool+anyp ps a = or (flist ps a)++{-+anyptest0 = anyp [(>=1),(>=2),(>=3)] 0     -- False+anyptest1 = anyp [(>=1),(>=2),(>=3)] 1     -- True+anyptest2 = anyp [(>=1),(>=2),(>=3)] 2     -- True+anyptest3 = anyp [(>=1),(>=2),(>=3)] 3     -- True+anyptest  = and [not anyptest0,anyptest1,anyptest2,anyptest3]+-}+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/LookupMap.hs view
@@ -0,0 +1,451 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  LookupMap+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  A lot of LANGUAGE extensions...+--+--  This module defines a lookup table format and associated functions+--  used by the graph matching code.+--+--------------------------------------------------------------------------------++------------------------------------------------------------+--  Generic list-of-pairs lookup functions+------------------------------------------------------------++module Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , emptyLookupMap, makeLookupMap, listLookupMap+    , reverseLookupMap+    , keyOrder+    , mapFind, mapFindMaybe, mapContains+    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap+    , mapAdd, mapAddIfNew+    , mapDelete, mapDeleteAll+    , mapApplyToAll, mapTranslate+    , mapEq, mapKeys, mapVals+    , mapSelect, mapMerge+    , mapSortByKey, mapSortByVal+    , mapTranslateKeys, mapTranslateVals+    , mapTranslateEntries, mapTranslateEntriesM+    )+    where++import qualified Data.Foldable as F+import qualified Data.Traversable as T+import qualified Data.List as L++import Data.Ord (comparing)++import Swish.Utils.ListHelpers ( equiv )++------------------------------------------------------------+--  Class for lookup map entries+------------------------------------------------------------++-- |@LookupEntryClass@ defines essential functions of any datatype+--  that can be used to make a 'LookupMap'.+--+--  Minimal definition: @newEntry@ and @keyVal@+--+class (Eq k, Show k) => LookupEntryClass a k v | a -> k, a -> v+    where+        newEntry    :: (k,v) -> a+        keyVal      :: a -> (k,v)+        entryKey    :: a -> k+        entryKey e = k where (k,_) = keyVal e+        entryVal    :: a -> v+        entryVal e = v where (_,v) = keyVal e+        entryEq     :: (Eq v) => a -> a -> Bool+        entryEq e1 e2 = keyVal e1 == keyVal e2+        entryShow   :: (Show v) => a -> String+        entryShow e = show k ++ ":" ++ show v where (k,v) = keyVal e+        kmap :: (LookupEntryClass a2 k2 v) => (k -> k2) -> a -> a2+        kmap f e    = newEntry (f $ entryKey e,entryVal e)+        vmap :: (LookupEntryClass a2 k v2) => (v -> v2) -> a -> a2+        vmap f e    = newEntry (entryKey e,f $ entryVal e)++-- |Predefine a pair of appropriate values as a valid lookup table entry+--  (i.e. an instance of LookupEntryClass).+--+instance (Eq k, Show k) => LookupEntryClass (k,v) k v where+    newEntry = id+    keyVal   = id++-- |Define a lookup map based on a list of values.+--+--  Note:  the class constraint that a is an instance of 'LookupEntryClass'+--  is not defined here, for good reasons (which I forget right now, but+--  something to do with the method dictionary being superfluous on+--  an algebraic data type).+--+data LookupMap a = LookupMap [a]+  deriving (Functor, F.Foldable, T.Traversable)++gLM :: LookupMap a -> [a]+gLM (LookupMap es) = es++-- |Define equality of 'LookupMap' values based on equality of entries.+--+--  (This is possibly a poor definition, as it is dependent on ordering+--  of list members.  But it passes all current test cases, and is used+--  only for testing.)+--+--  See also 'mapEq'+--  (why not just use that here?  I don't know:  it's probably historic.)+--+instance (Eq a) => Eq (LookupMap a) where+    LookupMap es1 == LookupMap es2 = es1 == es2++-- |Define Show instance for LookupMap based on Showing the+-- list of entries.+--+instance (Show a ) => Show (LookupMap a) where+    show (LookupMap es) = "LookupMap " ++ show es++{-+TODO: should the LookupEntryClass constraint be removed from+emptyLookupMap and makeLookupMap?++I guess not since LookupMap is exported, so users can use+that if they do not need the constraint.+-}++-- |Empty lookup map of arbitrary (i.e. polymorphic) type.+--+emptyLookupMap :: (LookupEntryClass a k v) => LookupMap a+emptyLookupMap = LookupMap []++-- |Function to create a `LookupMap` from a list of entries.+--+--  Currently, this is trivial but future versions could be+--  more substantial.+--+makeLookupMap :: (LookupEntryClass a k v) => [a] -> LookupMap a+makeLookupMap = LookupMap++-- |Return list of lookup map entries.+--+--  Currently, this is trivial but future versions could be+--  more substantial.+--+listLookupMap :: (LookupEntryClass a k v) => LookupMap a -> [a]+listLookupMap = gLM++-- |Given a lookup map entry, return a new entry that can be used+--  in the reverse direction of lookup.  This is used to construct+--  a reverse LookupMap.+--+reverseEntry :: (LookupEntryClass a1 k v, LookupEntryClass a2 v k)+    => a1 -> a2+reverseEntry e = newEntry (v,k) where (k,v) = keyVal e++-- |Given a lookup map, return a new map that can be used+--  in the opposite direction of lookup.+--+reverseLookupMap :: (LookupEntryClass a1 b c, LookupEntryClass a2 c b)+    => LookupMap a1 -> LookupMap a2+reverseLookupMap = fmap reverseEntry++-- |Given a pair of lookup entry values, return the ordering of their+--  key values.+--+keyOrder :: (LookupEntryClass a k v, Ord k)+    =>  a -> a -> Ordering+keyOrder e1 e2 = compare k1 k2+    where+        (k1,_) = keyVal e1+        (k2,_) = keyVal e2++--  Local helper function to build a new LookupMap from+--  a new entry and an exiting map.+--+mapCons :: a -> LookupMap a -> LookupMap a+mapCons e (LookupMap es) = LookupMap (e:es)++-- |Find key in lookup map and return corresponding value,+--  otherwise return default supplied.+--+mapFind :: (LookupEntryClass a k v) => v -> k -> LookupMap a -> v+mapFind def key (LookupMap es) = foldr match def es where+    match ent alt+        | key == entryKey ent   = entryVal ent+        | otherwise             = alt++-- |Find key in lookup map and return Just the corresponding value,+--  otherwise return Nothing.+--+mapFindMaybe :: (LookupEntryClass a k v) => k -> LookupMap a -> Maybe v+mapFindMaybe key (LookupMap es) = foldr match Nothing es where+    match ent alt+        | key ==  entryKey ent  = Just (entryVal ent)+        | otherwise             = alt++-- |Test to see if key is present in the supplied map+--+mapContains :: (LookupEntryClass a k v) =>+    LookupMap a -> k -> Bool+mapContains (LookupMap es) key  = any match es where+    match ent = key == entryKey ent++-- |Replace an existing occurrence of a key a with a new key-value pair.+--    +--  The resulting lookup map has the same form as the original in all+--  other respects.  Assumes exactly one occurrence of the supplied key.+--+mapReplace :: (LookupEntryClass a k v) =>+    LookupMap a -> a -> LookupMap a+mapReplace (LookupMap (e:es)) newe+    | entryKey e == entryKey newe       = LookupMap (newe:es)+    | otherwise                         = mapAdd more e where+        more = mapReplace (LookupMap es) newe+mapReplace _ newe =+    error ("mapReplace: Key value not found in lookup table: "+++           Prelude.show (entryKey newe))++-- |Replace an existing occurrence of a key a with a new key-value pair,+--  or add a new key-value pair if the supplied key is not already present.+--+mapReplaceOrAdd :: (LookupEntryClass a k v) =>+    a -> LookupMap a -> LookupMap a+mapReplaceOrAdd newe (LookupMap (e:es))+    | entryKey e == entryKey newe       = LookupMap (newe:es)+    | otherwise                         = mapCons e more where+        more = mapReplaceOrAdd newe (LookupMap es)+mapReplaceOrAdd newe (LookupMap [])     = LookupMap [newe]++-- |Replace any occurrence of a key a with a new key-value pair.+--+--  The resulting lookup map has the same form as the original in all+--  other respects.+--+mapReplaceAll :: (LookupEntryClass a k v) =>+    LookupMap a -> a -> LookupMap a+mapReplaceAll (LookupMap (e:es)) newe   = mapCons e' more where+    more = mapReplaceAll (LookupMap es) newe+    e'   = if entryKey e == entryKey newe then newe else e+mapReplaceAll (LookupMap []) _          = LookupMap []++-- |Replace any occurrence of a key in the first argument with a+--  corresponding key-value pair from the second argument, if present.+--+--  This could be implemented by multiple applications of 'mapReplaceAll',+--  but is arranged differently so that only one new @LookupMap@ value is+--  created.+--+--  Note:  keys in the new map that are not present in the old map+--  are not included in the result map+--+mapReplaceMap :: (LookupEntryClass a k v) =>+    LookupMap a -> LookupMap a -> LookupMap a+mapReplaceMap (LookupMap (e:es)) newmap = mapCons e' more where+    more  = mapReplaceMap (LookupMap es) newmap+    e'    = newEntry (k,mapFind v k newmap)+    (k,v) = keyVal e+mapReplaceMap (LookupMap []) _ = LookupMap []++-- |Add supplied key-value pair to the lookup map.+--+--  This is effectively an optimized case of 'mapReplaceOrAdd' or 'mapAddIfNew',+--  where the caller guarantees to avoid duplicate key values.+--+mapAdd :: LookupMap a -> a -> LookupMap a+mapAdd emap e = mapCons e emap++-- |Add supplied key-value pair to the lookup map,+--  only if the key value is not already present.+--+mapAddIfNew :: (LookupEntryClass a k v) =>+    LookupMap a -> a -> LookupMap a+mapAddIfNew emap e = if mapContains emap (entryKey e)+                        then emap+                        else mapCons e emap++-- |Delete supplied key value from the lookup map.+--+--  This function assumes exactly one occurrence.+--+mapDelete :: (LookupEntryClass a k v) =>+    LookupMap a -> k -> LookupMap a+mapDelete (LookupMap (e:es)) k+    | k == entryKey e   = LookupMap es+    | otherwise         = mapCons e more where+        more = mapDelete (LookupMap es) k+mapDelete _ k =+    error ("mapDelete: Key value not found in lookup table: " ++ Prelude.show k)++-- |Delete any occurrence of a supplied key value from the lookup map.+--+mapDeleteAll :: (LookupEntryClass a k v) =>+    LookupMap a -> k -> LookupMap a+mapDeleteAll (LookupMap (e:es)) k =+    if entryKey e == k then more else mapCons e more where+        more = mapDeleteAll (LookupMap es) k+mapDeleteAll (LookupMap []) _ = LookupMap []++-- |Return a list of values obtained by applying a function to each key+--  in the map.  Creates an alternative set of values that can be+--  retrieved using mapTranslate.+--+mapApplyToAll :: (LookupEntryClass a k v) =>+    LookupMap a -> (k -> w) -> [w]+mapApplyToAll es f = gLM $ fmap (f . entryKey) es++-- |Find a node in a lookup map list, and returns the+--  corresponding value from a supplied list.  The appropriate ordering+--  of the list is not specified here, but an appropriately ordered list+--  may be obtained by 'mapApplyToAll'.+--+mapTranslate :: (LookupEntryClass a k v) =>+    LookupMap a -> [w] -> k -> w -> w+mapTranslate (LookupMap (e:es)) (w:ws) k def+    | k == entryKey e   = w+    | otherwise         = mapTranslate (LookupMap es) ws k def+mapTranslate _ _ _ def = def++-- |Compare two lookup maps for equality.+--+--  Two maps are equal if they have the same set of keys, and if+--  each key maps to an equivalent value.+--+mapEq :: (LookupEntryClass a k v, Eq v) =>+    LookupMap a -> LookupMap a -> Bool+mapEq es1 es2 =+    ks1 `equiv` ks2 &&+    and [ mapFindMaybe k es1 == mapFindMaybe k es2 | k <- ks1 ]+    where+        ks1 = mapKeys es1+        ks2 = mapKeys es2++-- |Return the list of keys in a supplied LookupMap+--+mapKeys :: (LookupEntryClass a k v) =>+    LookupMap a -> [k]+mapKeys (LookupMap es) = L.nub $ map (fst . keyVal) es++-- |Return list of distinct values in a supplied LookupMap+--+mapVals :: (Eq v, LookupEntryClass a k v) =>+    LookupMap a -> [v]+mapVals (LookupMap es) = L.nub $ map (snd . keyVal) es++-- |Select portion of a lookup map that corresponds to+--  a supplied list of keys+--+mapSelect :: (LookupEntryClass a k v) =>+    LookupMap a -> [k] -> LookupMap a+mapSelect (LookupMap es) ks =+    LookupMap $ filter (keyIn ks) es+    where+        keyIn iks e = fst (keyVal e) `elem` iks++-- |Merge two lookup maps, ensuring that if the same key appears+--  in both maps it is associated with the same value.+--+mapMerge :: (LookupEntryClass a k v, Eq a, Show a, Ord k) =>+    LookupMap a -> LookupMap a -> LookupMap a+mapMerge (LookupMap s1) (LookupMap s2) =+    LookupMap $ merge (L.sortBy keyOrder s1) (L.sortBy keyOrder s2)+    where+        merge es1 [] = es1+        merge [] es2 = es2+        merge es1@(e1:et1) es2@(e2:et2) =+            case keyOrder e1 e2 of+                LT -> e1 : merge et1 es2+                GT -> e2 : merge es1 et2+                EQ -> if e1 /= e2+                        then error ("mapMerge key conflict: " ++ show e1+                                    ++ " with " ++ show e2)+                        else e1 : merge et1 et2++-- |Creates a new map that is the same as the supplied map, except+--  that its entries are sorted by key value.+--+--  (What's this used for?  It should be redundant.)+--+mapSortByKey :: (LookupEntryClass a k v, Ord k) =>+    LookupMap a -> LookupMap a+mapSortByKey (LookupMap es) =+    LookupMap $ L.sortBy (comparing entryKey) es++-- |Creates a new map that is the same as the supplied map, except+--  that its entries are sorted by key value.+--+--  (What's this used for?  It should be redundant.)+--+mapSortByVal :: (LookupEntryClass a k v, Ord v) =>+    LookupMap a -> LookupMap a+mapSortByVal (LookupMap es) =+    LookupMap $ L.sortBy (comparing entryVal) es++-- |An fmap-like function that returns a new lookup map that is a+--  copy of the supplied map with entry keys replaced according to+--  a supplied function.+--+mapTranslateKeys :: (LookupEntryClass a1 k1 v, LookupEntryClass a2 k2 v) =>+    (k1 -> k2) -> LookupMap a1 -> LookupMap a2+mapTranslateKeys f = fmap (kmap f)++-- |An fmap-like function that returns a new lookup map that is a+--  copy of the supplied map with entry values replaced according to+--  a supplied function.+--+mapTranslateVals :: (LookupEntryClass a1 k v1, LookupEntryClass a2 k v2) =>+    (v1 -> v2) -> LookupMap a1 -> LookupMap a2+mapTranslateVals f = fmap (vmap f)++-- |A function that returns a new lookup map that is a copy of the+--  supplied map with complete entries replaced according to+--  a supplied function.+--+-- Since 'LookupMap' now has a 'Functor' instance this is just 'fmap'+mapTranslateEntries :: (a1 -> a2) -> LookupMap a1 -> LookupMap a2+mapTranslateEntries = fmap++-- |A monadic form of `mapTranslateEntries`.+--+-- Since `LookupMap` now has a `Data.Traversable.Traversable` instance+-- this is just `T.mapM`.+--+mapTranslateEntriesM :: (Monad m)+    => (a1 -> m a2) -> LookupMap a1 -> m (LookupMap a2)+mapTranslateEntriesM = T.mapM +{-+mapTranslateEntriesM f (LookupMap es) =+    do  { m2 <- mapM f es+        ; return $ LookupMap m2+        }+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/MiscHelpers.hs view
@@ -0,0 +1,111 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  MiscHelpers+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines some generic list and related helper functions+--  used by the graph handling code.+--+--------------------------------------------------------------------------------++module Swish.Utils.MiscHelpers+      ( assert, lower, stricmp, quote, hash, hashModulus )+where++import Data.Char+    ( toLower )++------------------------------------------------------------+--  assert test+------------------------------------------------------------++assert :: Bool -> String -> a -> a+assert cond msg expr = if not cond then error msg else expr++------------------------------------------------------------+--  Generate lowercase form of supplied string+------------------------------------------------------------++lower :: String -> String+lower = foldr ((:) . toLower) "" ++------------------------------------------------------------+--  Case insensitive compare.+------------------------------------------------------------+--+--  Should be used only for values using just the US ASCII+--  character set.  Use with richer character sets can yield+--  surprising results.++stricmp :: String -> String -> Bool+stricmp (c1:s1) (c2:s2) = toLower c1 == toLower c2 && stricmp s1 s2+stricmp []      []      = True+stricmp _       _       = False++------------------------------------------------------------+--  Generate quoted form of supplied string:+------------------------------------------------------------+--+--  [[[TODO: The list of quoting options here is incomplete]]]++quote :: String -> String+quote  st = ['"'] ++ quote1 st ++ ['"']++quote1 :: String -> String+quote1 ('"': st)    = '\\':'"' : quote1 st+quote1 ('\\':st)    = '\\':'\\': quote1 st+quote1 ('\n':st)    = '\\':'n': quote1 st+quote1 ('\r':st)    = '\\':'r': quote1 st+quote1 (c:st)       = c: quote1 st+quote1 []           = ""++------------------------------------------------------------+--  Hash function and values+------------------------------------------------------------+--+--  Simple hash function based on Sedgewick, Algorithms in C, p 233+--  (choose mx*cm+255 < maxBound)+--  'seed' is an additional parameter that allows the function+--  to be varied for re-hashing.++hashModulus :: Int+hashModulus = 16000001++hash :: Int -> String -> Int+hash seed = hash1 seed (64+seed) hashModulus ++hash1 :: Int -> Int -> Int -> String -> Int+hash1 sofar cm mx (c:str) = hash1 (( sofar*cm + fromEnum c ) `rem` mx) cm mx str+hash1 sofar _ _ []        = sofar+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/Namespace.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Namespace+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  TypeSynonymInstances, MultiParamTypeClasses+--+--  This module defines algebraic datatypes for namespaces and scoped names.+--+--  For these purposes, a namespace is a prefix and URI used to identify+--  a namespace (cf. XML namespaces), and a scoped name is a name that+--  is scoped by a specified namespace.+--+--------------------------------------------------------------------------------++module Swish.Utils.Namespace+    ( Namespace(..)+    , makeNamespaceQName+    , nullNamespace+    , ScopedName(..)+    , getScopePrefix, getScopeURI+    , getQName, getScopedNameURI+    , matchName+    , makeScopedName, makeQNameScopedName, makeUriScopedName+    , nullScopedName+    )+where++import Swish.Utils.QName+    ( QName(..), getQNameURI )++import Swish.Utils.LookupMap+    ( LookupEntryClass(..) )++------------------------------------------------------------+--  Namespace, having a prefix and a URI+------------------------------------------------------------++-- |A NameSpace value consists of a prefix and a corresponding URI.+--  The prefix may be empty (@\"\"@), in which case it is assumed to be unknown.+--+-- NOTE: not clear whether @nsPrefix@ should be empty or set to @\"?\"@.+--+data Namespace = Namespace { nsPrefix :: String, nsURI :: String }++{-+getNamespacePrefix :: Namespace -> String+getNamespacePrefix = nsPrefix++getNamespaceURI    :: Namespace -> String+getNamespaceURI    = nsURI+-}++instance Eq Namespace where+    (==) = nsEq++instance Show Namespace where+    show (Namespace p u) =+        (if p == "?" then "" else p ++ ":") ++ "<" ++ u ++ ">"++instance LookupEntryClass Namespace String String where+    keyVal   (Namespace pre uri) = (pre,uri)+    newEntry (pre,uri)           = Namespace pre uri++nsEq :: Namespace -> Namespace -> Bool+nsEq (Namespace _ u1) (Namespace _ u2) = u1 == u2++makeNamespaceQName :: Namespace -> String -> QName+makeNamespaceQName ns = QName (nsURI ns)++nullNamespace :: Namespace+nullNamespace = Namespace "?" ""++------------------------------------------------------------+--  ScopedName, made from a namespace and a local name+------------------------------------------------------------++-- |A full ScopedName value has a QName prefix, namespace URI+--  and a local part.  ScopedName values may omit the prefix+--  (see 'Namespace') or the local part.+--+--  Some applications may handle null namespace URIs as meaning+--  the local part is relative to some base URI.+--+data ScopedName = ScopedName { snScope :: Namespace, snLocal :: String }++getScopePrefix :: ScopedName -> String+getScopePrefix = nsPrefix . snScope++getScopeURI :: ScopedName -> String+getScopeURI = nsURI . snScope++instance Eq ScopedName where+    (==) = snEq++instance Ord ScopedName where+    (<=) = snLe++instance Show ScopedName where+    show (ScopedName n l) =+        if pre == "?" then "<"++uri++l++">" else pre++":"++l+        where+            pre = nsPrefix n+            uri = nsURI n++--  Scoped names are equal of ther corresponding QNames are equal+snEq :: ScopedName -> ScopedName -> Bool+snEq s1 s2 = getQName s1 == getQName s2++--  Scoped names are ordered by their QNames+snLe :: ScopedName -> ScopedName -> Bool+snLe s1 s2 = getQName s1 <= getQName s2++-- |Get QName corresponding to a scoped name+getQName :: ScopedName -> QName+getQName n = QName (getScopeURI n) (snLocal n)++-- |Get URI corresponding to a scoped name (using RDF conventions)+getScopedNameURI :: ScopedName -> String+getScopedNameURI = getQNameURI . getQName++-- |Test if supplied string matches the display form of a+--  scoped name.+matchName :: String -> ScopedName -> Bool+matchName str nam = str == show nam++-- |Construct a ScopedName from prefix, URI and local name+makeScopedName :: String -> String -> String -> ScopedName+makeScopedName pre nsuri =+    ScopedName (Namespace pre nsuri)++-- |Construct a ScopedName from a QName+makeQNameScopedName :: QName -> ScopedName+makeQNameScopedName (QName u l) = makeScopedName "?" u l++-- |Construct a ScopedName for a bare URI+makeUriScopedName :: String -> ScopedName+makeUriScopedName u = makeScopedName "?" u ""++-- |This should never appear as a valid name+nullScopedName :: ScopedName+nullScopedName = makeScopedName "?" "" ""++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/PartOrderedCollection.hs view
@@ -0,0 +1,375 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  PartOrderedCollection+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module provides methods to support operations on partially ordered+--  collections.  The partial ordering relationship is represented by+--  Maybe `Ordering`.+--+--  Thanks to members of the haskell-cafe mailing list -+--    Robert (rvollmert-lists@gmx.net) and+--    Tom Pledger (Tom.Pledger@peace.com) -+--  who suggested key ideas on which some of the code in this module is based.+--+--------------------------------------------------------------------------------++module Swish.Utils.PartOrderedCollection+    ( PartCompare+    , minima, maxima+    , partCompareEq, partCompareOrd, partComparePair+    , partCompareListPartOrd, partCompareListOrd+    , partCompareMaybe, partCompareListMaybe+    , partCompareListSubset+    )+where++------------------------------------------------------------+--  Type of partial compare function+------------------------------------------------------------++type PartCompare a = a -> a -> Maybe Ordering++------------------------------------------------------------+--  Functions for minima and maxima of a part-ordered list+------------------------------------------------------------++-- |This function finds the maxima in a list of partially+--  ordered values, preserving the sequence of retained+--  values from the supplied list.+--+--  It returns all those values in the supplied list+--  for which there is no larger element in the list.+--+maxima :: PartCompare a -> [a] -> [a]+maxima cmp as = foldl add [] as+    where+        add []     e = [e]+        add ms@(m:mr) e = case cmp m e of+            Nothing -> m : add mr e+            Just GT -> ms+            Just EQ -> ms+            Just LT -> add mr e++-- |This function finds the minima in a list of partially+--  ordered values, preserving the sequence of retained+--  values from the supplied list.+--+--  It returns all those values in the supplied list+--  for which there is no smaller element in the list.+--+minima :: PartCompare a -> [a] -> [a]+minima cmp = maxima (flip cmp)++------------------------------------------------------------+--  Partial ordering comparison functions+------------------------------------------------------------++-- |Partial ordering for Eq values+partCompareEq :: (Eq a) => a -> a -> Maybe Ordering+partCompareEq a1 a2 = if a1 == a2 then Just EQ else Nothing++-- |Partial ordering for Ord values+partCompareOrd :: (Ord a) => a -> a -> Maybe Ordering+partCompareOrd a1 a2 = Just $ compare a1 a2++-- |Part-ordering comparison on pairs of values,+--  where each has a part-ordering relationship+partComparePair ::+    (a->a->Maybe Ordering) -> (b->b->Maybe Ordering) -> (a,b) -> (a,b)+    -> Maybe Ordering+partComparePair cmpa cmpb (a1,b1) (a2,b2) = case (cmpa a1 a2,cmpb b1 b2) of+    (_,Nothing)       -> Nothing+    (jc1,Just EQ)     -> jc1+    (Nothing,_)       -> Nothing+    (Just EQ,jc2)     -> jc2+    (Just c1,Just c2) -> if c1 == c2 then Just c1 else Nothing++-- |Part-ordering comparison on lists of partially ordered values, where:+--+--  [@as==bs@]  if members of as are all equal to corresponding members of bs+--    +--  [@as<=bs@]  if members of as are all less than or equal to corresponding+--          members of bs+--    +--  [@as>=bs@]  if members of as are all greater than or equal to corresponding+--          members of bs+--    +--  [otherwise] as and bs are unrelated+--+--  The comparison is restricted to the common elements in the two lists.+--+partCompareListPartOrd :: PartCompare a -> [a] -> [a] -> Maybe Ordering+partCompareListPartOrd cmp a1s b1s = pcomp a1s b1s EQ+    where+        pcomp (a:as) (b:bs) ordp = case cmp a b of+            Just rel  -> pcomp1 as bs rel ordp+            _         -> Nothing+        pcomp _      _      ordp = Just ordp+        -- pcomp []     []     ordp = Just ordp+        +        pcomp1 as bs ordn EQ   = pcomp as bs ordn+        pcomp1 as bs EQ   ordp = pcomp as bs ordp+        pcomp1 as bs ordn ordp =+            if ordn == ordp then pcomp as bs ordp else Nothing+                                                       +-- |Part-ordering comparison on lists of Ord values, where:+--+--  [@as==bs@]  if members of as are all equal to corresponding members of bs+--    +--  [@as<=bs@]  if members of as are all less than or equal to corresponding+--          members of bs+--    +--  [@as>=bs@]  if members of as are all greater than or equal to corresponding+--          members of bs+--    +--  [otherwise] as and bs are unrelated+--+partCompareListOrd :: (Ord a) => [a] -> [a] -> Maybe Ordering+partCompareListOrd = partCompareListPartOrd (Just `c2` compare)+    where c2 = (.) . (.)++-- |Part-ordering comparison for Maybe values.+partCompareMaybe :: (Eq a) => Maybe a -> Maybe a -> Maybe Ordering+partCompareMaybe Nothing  Nothing  = Just EQ+partCompareMaybe (Just _) Nothing  = Just GT+partCompareMaybe Nothing  (Just _) = Just LT+partCompareMaybe (Just a) (Just b) = if a == b then Just EQ else Nothing++-- |Part-ordering comparison on lists of Maybe values.+partCompareListMaybe :: (Eq a) => [Maybe a] -> [Maybe a] -> Maybe Ordering+partCompareListMaybe = partCompareListPartOrd partCompareMaybe++-- |Part-ordering comparison on lists based on subset relationship+partCompareListSubset :: (Eq a) => [a] -> [a] -> Maybe Ordering+partCompareListSubset a b+    | aeqvb     = Just EQ+    | asubb     = Just LT+    | bsuba     = Just GT+    | otherwise = Nothing+    where+        asubb = a `subset` b+        bsuba = b `subset` a+        aeqvb = asubb && bsuba+        x `subset` y = and [ ma `elem` y | ma <- x ]++------------------------------------------------------------+--  Test cases+------------------------------------------------------------++{-++notTrueFalse  = Nothing :: Maybe Bool++-- partCompareListOrd+test01 = partCompareListOrd [1,2,3] [1,2,3] == Just EQ+test02 = partCompareListOrd [1,2,3] [2,3,4] == Just LT+test03 = partCompareListOrd [1,2,4] [1,2,3] == Just GT+test04 = partCompareListOrd [1,2,3] [2,1,3] == Nothing++-- partCompareMaybe+test11 = partCompareMaybe (Just True)  (Just True)  == Just EQ+test12 = partCompareMaybe (Just True)  (Just False) == Nothing+test13 = partCompareMaybe notTrueFalse (Just False) == Just LT+test14 = partCompareMaybe (Just True)  notTrueFalse == Just GT+test15 = partCompareMaybe notTrueFalse notTrueFalse == Just EQ++-- partCompareListMaybe+test21 = partCompareListMaybe [Just True,Just False]+                              [Just True,Just False]+            == Just EQ+test22 = partCompareListMaybe [Just True,Just False]+                              [Just True,Just True]+            == Nothing+test23 = partCompareListMaybe [Just False,Just True]+                              [Just False,Just True]+            == Just EQ+test24 = partCompareListMaybe [Nothing,   Just True]+                              [Just False,Just True]+            == Just LT+test25 = partCompareListMaybe [Just False,Just True]+                              [Just False,Nothing]+            == Just GT+test26 = partCompareListMaybe [Nothing,   Just True]+                              [Just False,Nothing]+            == Nothing+test27 = partCompareListMaybe [Nothing,Just True]+                              [Nothing,Nothing]+            == Just GT+test28 = partCompareListMaybe [notTrueFalse,notTrueFalse]+                              [notTrueFalse,notTrueFalse]+            == Just EQ++--  minima, maxima+test31a = maxima partCompareListMaybe ds1a == ds1b+test31b = minima partCompareListMaybe ds1a == ds1c+ds1a =+    [ [Just 'a',Just 'b',Just 'c']+    , [Just 'a',Just 'b',Nothing ]+    , [Just 'a',Nothing ,Just 'c']+    , [Just 'a',Nothing ,Nothing ]+    , [Nothing ,Just 'b',Just 'c']+    , [Nothing ,Just 'b',Nothing ]+    , [Nothing ,Nothing ,Just 'c']+    , [Nothing ,Nothing ,Nothing ]+    ]+ds1b =+    [ [Just 'a',Just 'b',Just 'c']+    ]+ds1c =+    [ [Nothing ,Nothing ,Nothing ]+    ]++test32a = maxima partCompareListMaybe ds2a == ds2b+test32b = minima partCompareListMaybe ds2a == ds2c+ds2a =+    [ [Just 'a',Just 'b',Nothing ]+    , [Just 'a',Nothing ,Just 'c']+    , [Just 'a',Nothing ,Nothing ]+    , [Nothing ,Just 'b',Just 'c']+    , [Nothing ,Just 'b',Nothing ]+    , [Nothing ,Nothing ,Just 'c']+    ]+ds2b =+    [ [Just 'a',Just 'b',Nothing ]+    , [Just 'a',Nothing ,Just 'c']+    , [Nothing ,Just 'b',Just 'c']+    ]+ds2c =+    [ [Just 'a',Nothing ,Nothing ]+    , [Nothing ,Just 'b',Nothing ]+    , [Nothing ,Nothing ,Just 'c']+    ]++test33a = maxima partCompareListMaybe ds3a == ds3b+test33b = minima partCompareListMaybe ds3a == ds3c+ds3a =+    [ [Just "a1",Just "b1",Just "c1"]+    , [Just "a2",Just "b2",Nothing  ]+    , [Just "a3",Nothing  ,Just "c3"]+    , [Just "a4",Nothing  ,Nothing  ]+    , [Nothing  ,Just "b5",Just "c5"]+    , [Nothing  ,Just "b6",Nothing  ]+    , [Nothing  ,Nothing  ,Just "c7"]+    ]+ds3b =+    [ [Just "a1",Just "b1",Just "c1"]+    , [Just "a2",Just "b2",Nothing  ]+    , [Just "a3",Nothing  ,Just "c3"]+    , [Just "a4",Nothing  ,Nothing  ]+    , [Nothing  ,Just "b5",Just "c5"]+    , [Nothing  ,Just "b6",Nothing  ]+    , [Nothing  ,Nothing  ,Just "c7"]+    ]+ds3c =+    [ [Just "a1",Just "b1",Just "c1"]+    , [Just "a2",Just "b2",Nothing  ]+    , [Just "a3",Nothing  ,Just "c3"]+    , [Just "a4",Nothing  ,Nothing  ]+    , [Nothing  ,Just "b5",Just "c5"]+    , [Nothing  ,Just "b6",Nothing  ]+    , [Nothing  ,Nothing  ,Just "c7"]+    ]+++test34a = maxima partCompareListMaybe ds4a == ds4b+test34b = minima partCompareListMaybe ds4a == ds4c+ds4a =+    [ [Just 1, Just 1 ]+    , [Just 2, Nothing]+    , [Nothing,Just 3 ]+    , [Nothing,Nothing]+    ]+ds4b =+    [ [Just 1, Just 1 ]+    , [Just 2, Nothing]+    , [Nothing,Just 3 ]+    ]+ds4c =+    [ [Nothing,Nothing]+    ]++-- Check handling of equal values+test35a = maxima partCompareListMaybe ds5a == ds5b+test35b = minima partCompareListMaybe ds5a == ds5c+ds5a =+    [ [Just 1, Just 1 ]+    , [Just 2, Nothing]+    , [Nothing,Just 3 ]+    , [Nothing,Nothing]+    , [Just 1, Just 1 ]+    , [Just 2, Nothing]+    , [Nothing,Just 3 ]+    , [Nothing,Nothing]+    ]+ds5b =+    [ [Just 1, Just 1 ]+    , [Just 2, Nothing]+    , [Nothing,Just 3 ]+    ]+ds5c =+    [ [Nothing,Nothing]+    ]++-- test case 32 with different ordering of values+test36a = maxima partCompareListMaybe ds6a == ds6b+test36b = minima partCompareListMaybe ds6a == ds6c+ds6a =+    [ [Just 'a',Just 'b',Nothing ]+    , [Nothing ,Nothing ,Just 'c']+    , [Nothing ,Just 'b',Nothing ]+    , [Nothing ,Just 'b',Just 'c']+    , [Just 'a',Nothing ,Nothing ]+    , [Just 'a',Nothing ,Just 'c']+    ]+ds6b =+    [ [Just 'a',Just 'b',Nothing ]+    , [Nothing ,Just 'b',Just 'c']+    , [Just 'a',Nothing ,Just 'c']+    ]+ds6c =+    [ [Nothing ,Nothing ,Just 'c']+    , [Nothing ,Just 'b',Nothing ]+    , [Just 'a',Nothing ,Nothing ]+    ]++test = and+    [ test01, test02, test03, test04+    , test11, test12, test13, test14, test15+    , test21, test22, test23, test24, test25, test26, test27, test28+    , test31a, test31b, test32a, test32b, test33a, test33b+    , test34a, test34b, test35a, test35b, test36a, test36b+    ]++-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/QName.hs view
@@ -0,0 +1,175 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  QName+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines an algebraic datatype for qualified names (QNames).+--+--------------------------------------------------------------------------------++module Swish.Utils.QName+    ( QName(..) -- , maybeQnEq+    , newQName, qnameFromPair, qnameFromURI+    , getNamespace, getLocalName, getQNameURI+    , splitURI+    , qnameFromFilePath+    )+where++import Data.Char (isAlpha, isAlphaNum)++import System.Directory (canonicalizePath)+import System.FilePath (splitDirectories)+import Data.List (intercalate)++------------------------------------------------------------+--  Qualified name+------------------------------------------------------------+--+--  cf. http://www.w3.org/TR/REC-xml-names/++data QName = QName { qnNsuri, qnLocal :: String }++newQName :: String -> String -> QName+newQName = QName++qnameFromPair :: (String,String) -> QName+qnameFromPair (ns,ln) = QName ns ln++qnameFromURI :: String -> QName+qnameFromURI = qnameFromPair . splitURI++getNamespace :: QName -> String+getNamespace = qnNsuri++getLocalName :: QName -> String+getLocalName = qnLocal++getQNameURI :: QName -> String+getQNameURI (QName ns ln) = ns++ln++instance Eq QName where+    (==) = qnEq++instance Ord QName where+    (QName u1 l1) <= (QName u2 l2) =+        if up1 /= up2 then up1 <= up2 else (ur1++l1) <= (ur2++l2)+        where+            n   = min (length u1) (length u2)+            (up1,ur1) = splitAt n u1+            (up2,ur2) = splitAt n u2++instance Show QName where+    show (QName ns ln) = "<" ++ ns ++ ln ++ ">"++--  Original used comparison of concatenated strings,+--  but that was very inefficient.  This version does the+--  comparison without constructing new values+qnEq :: QName -> QName -> Bool+qnEq (QName n1 l1) (QName n2 l2) = qnEq1 n1 n2 l1 l2+  where+    qnEq1 (c1:ns1) (c2:ns2)  ln1 ln2   = c1==c2 && qnEq1 ns1 ns2 ln1 ln2+    qnEq1 []  ns2  ln1@(_:_) ln2       = qnEq1 ln1 ns2 []  ln2+    qnEq1 ns1 []   ln1       ln2@(_:_) = qnEq1 ns1 ln2 ln1 []+    qnEq1 []  []   []        []        = True+    qnEq1 _   _    _         _         = False++{-+--  Define equality of (Maybe QName)+maybeQnEq :: (Maybe QName) -> (Maybe QName) -> Bool+maybeQnEq Nothing   Nothing   = True+maybeQnEq (Just q1) (Just q2) = q1 == q2+maybeQnEq _         _         = False+-}++-- Separate URI string into namespace URI and local name+splitURI :: String -> ( String, String )+  -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")+  -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")+  -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")+splitURI qn = splitAt (scanURI qn (-1) 0) qn++-- helper function for splitQName+-- Takes 3 arguments:+--   QName to scan+--   index of last name-start char, or (-1)+--   number of characters scanned so far+-- Returns index of start of name, or length of list+--+scanURI :: String -> Int -> Int -> Int+scanURI (nextch:more) (-1) nc+    | isNameStartChar nextch  = scanURI more nc   (nc+1)+    | otherwise               = scanURI more (-1) (nc+1)+scanURI (nextch:more) ns nc+    | not (isNameChar nextch) = scanURI more (-1) (nc+1)+    | otherwise               = scanURI more ns   (nc+1)+scanURI "" (-1) nc = nc+scanURI "" ns   _  = ns++++-- Definitions here per XML namespaces, NCName production,+-- restricted to characters used in URIs.+-- cf. http://www.w3.org/TR/REC-xml-names/++isNameStartChar :: Char -> Bool+isNameStartChar c = isAlpha c || c == '_'++isNameChar :: Char -> Bool+isNameChar      c = isAlphaNum c || c `elem` ".-_"++{-|+Convert a filepath to a file: URI stored in a QName. If the+input file path is relative then the working directory is used+to convert it into an absolute path.++If the input represents a directory then it *must* end in +the directory separator - e.g. @\"\/foo\/bar\/\"@ rather than +@\"\/foo\/bar\"@+for Posix systems.++This has not been tested on Windows.+-}+qnameFromFilePath :: FilePath -> IO QName+qnameFromFilePath = fmap qnameFromURI . filePathToURI+  +filePathToURI :: FilePath -> IO String+filePathToURI fname = do+  ipath <- canonicalizePath fname+  let paths = splitDirectories ipath+      txt = intercalate "/" $ case paths of+        "/":rs -> rs+        _      -> paths+  +  return $ "file:///" ++ txt++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/ShowM.hs view
@@ -0,0 +1,83 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  ShowM+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines an extension of the Show class for displaying+--  multi-line values.  It serves the following purposes:+--+--  (1) provides a method with greater layout control of multiline values,+--+--  (2) provides a possibility to override the default Show behaviour+--      for programs that use the extended ShowM interface, and+--+--  (3) uses a ShowS intermediate value to avoid unnecessary+--      concatenation of long strings.+--+--------------------------------------------------------------------------------++module Swish.Utils.ShowM+    ( ShowM(..), showm+    )+where++------------------------------------------------------------+--  ShowM framework+------------------------------------------------------------++-- |ShowM is a type class for values that may be formatted in+--  multi-line displays.+class (Show sh) => ShowM sh where+    -- |Multi-line value display method+    --  Create a multiline displayable form of a value, returned+    --  as a 'ShowS' value.  The default implementation behaves just+    --  like a normal instance of 'Show'.+    --+    --  This function is intended to allow the calling function some control+    --  of multiline displays by providing:+    --+    --  (1) the first line of the value is not preceded by any text, so+    --      it may be appended to some preceding text on the same line,+    --+    --  (2) the supplied line break string is used to separate lines of the+    --      formatted text, and may include any desired indentation, and+    --+    --  (3) no newline is output following the final line of text.+    showms :: String -> sh -> ShowS+    showms _ = shows++-- |Return a string representation of a ShowM value.+showm :: (ShowM sh) => String -> sh -> String+showm linebreak val = showms linebreak val ""+++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ Swish/Utils/TraceHelpers.hs view
@@ -0,0 +1,58 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  TraceHelpers+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module provides access to tracing functions from the pre-2003+--  Hugs trace module.  Over time, it may accumulate other tracing+--  functions that I find useful.+--+--  This should probably just be replaced by "Debug.Trace".+--+--------------------------------------------------------------------------------++module Swish.Utils.TraceHelpers+    ( trace, traceShow+    )+where++import Debug.Trace+    ( trace )++------------------------------------------------------------+--  traceShow function from older Hugs trace module+------------------------------------------------------------++traceShow :: Show a => String -> a -> a+traceShow msg x = trace (msg ++ show x) x++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ src/Swish.hs view
@@ -0,0 +1,90 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Swish+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module is a wrapper for the main program of Swish.+--+--------------------------------------------------------------------------------++module Main where++import Paths_swish (version)+import Data.Version (showVersion)++import System.Environment (getArgs)+import System.Exit (ExitCode(ExitSuccess,ExitFailure), exitWith)++import Control.Monad (unless)++import System.IO (stderr, hPutStrLn)++import Swish.RDF.SwishMain++------------------------------------------------------------+--  Swish main program+------------------------------------------------------------+--+--  This is a minimal wrapper for the real main program, to facilitate+--  interactive execution (e.g. in HUGS) of different command lines.+--+--  execStateT runs the monad with a supplied initial state,+--  then separates the resulting state from the IO monad.++main :: IO ()+main = do+  args <- getArgs+  let (flags, cmds) = splitArguments args+      doHelp = "-h" `elem` flags+      doVersion = "-v" `elem` flags+      doQuiet = "-q" `elem` flags+      +  if doHelp || doVersion+    then if doHelp then displaySwishHelp else displayVersion >> exitWith ExitSuccess+    else do+      unless doQuiet $ displayVersion >> putStrLn "\n"+      case validateCommands cmds of+        Left (emsg, ecode) -> do+          hPutStrLn stderr $ "Swish: " ++ emsg+          exitWith $ ExitFailure $ fromEnum ecode+          +        Right acts -> do+          code <- runSwishActions acts+          case code of+            SwishSuccess -> exitWith ExitSuccess+            _ -> hPutStrLn stderr ("Swish: "++show code)+                 >> exitWith (ExitFailure $ fromEnum code)+  +displayVersion :: IO ()+displayVersion = putStrLn $ "Swish " ++ showVersion version +  +--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
swish.cabal view
@@ -1,12 +1,19 @@-Name:                swish-Version:             0.2.1-License:             LGPL-License-file:        LICENSE -Author:              Graham Klyne - GK@ninebynine.org-Maintainer:          Vasili I Galchin (William Halchin) - vigalchin@gmail.com +Name:               swish+Version:            0.3.0.0+Stability:          experimental+License:            LGPL+License-file:       LICENSE +Author:             Graham Klyne - GK@ninebynine.org+Copyright:          (c) 2003, 2004 G. Klyne; 2009 Vasili I Galchin; 2011 Doug Burke; All rights reserved.+Maintainer:         dburke@cfa.harvard.edu+Category:           Semantic Web+Synopsis:           A semantic web toolkit.  -Category:            Semantic Web-Synopsis:            A semantic web toolkit. +Tested-With:        GHC==6.12.3+Cabal-Version:      >= 1.6+Homepage:           https://bitbucket.org/doug_burke/swish/wiki/Home+Bug-reports:        https://bitbucket.org/doug_burke/swish/issues+ Description:        Swish is a framework, written in the purely functional                      programming language Haskell, for performing deductions in                      RDF data using a variety of techniques. Swish is conceived @@ -14,347 +21,303 @@                     implementing stand-alone RDF file processors (usable in                      similar style to CWM, but with a view to being extensible                      in declarative style through added Haskell function and data-                    value declarations). It explores Haskell as "a scripting -                    language for the Semantic Web".-+                    value declarations). It explores Haskell as \"a scripting +                    language for the Semantic Web\".+                    .                     Swish is a work-in-progress, and currently incorporates:--                    * Notation3 input and output.+                    .+                    * Notation3 and NTriples input and output. The N3 support is+                      incomplete (no handling of @forAll@).+                    .                     * RDF graph isomorphism testing and merging.+                    .                     * Display of differences between RDF graphs.+                    .                     * Inference operations in forward chaining, backward chaining and proof-checking modes.+                    .                     * Simple Horn-style rule implementations, extendable through variable binding modifiers and filters.+                    .                     * Class restriction rule implementation, primarily for datatype inferences.+                    .                     * RDF formal semantics entailment rule implementation.+                    .                     * Complete, ready-to-run, command-line and script-driven programs.+                    .+                    Major Changes:+                    .+                    [Version 0.3.0.0] is an attempt to update +                    version 0.2.1 (<http://hackage.haskell.org/package/swish-0.2.1/>)+		    to build against+                    a recent ghc install, with some clean ups - including support for+                    the current N3 specification - and the addition of the+                    NTriples format. It has not been tested against ghc7.+                    .+                    References:+                    .+                      - <http://www.ninebynine.org/RDFNotes/Swish/Intro.html>+                    .+                      - <http://www.ninebynine.org/Software/swish-0.2.1.html>+                    .+                      - CWM: <http://www.w3.org/2000/10/swap/doc/cwm.html>+                    . -                    References+Build-Type:         Simple+Data-Files:         README -                    1) http://www.ninebynine.org/RDFNotes/Swish/Intro.html+Source-repository head+  type:     mercurial+  location: https://bitbucket.org/doug_burke/swish -                    2) http://www.ninebynine.org/Software/swish-0.2.1.html+Flag  tests+  Description: Build the test programs.+  Default:     False -Tested-With:         GHC>=6.8.2-Build-Type:          Simple-Data-Files:          README+Flag  hpc+  Description: Use Hpc for the tests+  Default:     False -Cabal-Version:       >= 1.2  Library-   Build-Depends:       base>3 && <4, binary, bytestring, containers, array, parallel, parsec, random, old-time, mtl, HUnit-   Exposed-modules:     Swish.HaskellRDF.BuiltInDatatypes,-                        Swish.HaskellRDF.BuiltInMap,-                        Swish.HaskellRDF.BuiltInRules,-                        Swish.HaskellRDF.ClassRestrictionRule,-                        Swish.HaskellRDF.Dfa.Dfa-                        Swish.HaskellRDF.Datatype,-                        Swish.HaskellRDF.GraphClass-                        Swish.HaskellRDF.GraphMatch,-                        Swish.HaskellRDF.GraphMem,-                        Swish.HaskellRDF.GraphPartition,-                        Swish.HaskellRDF.MapXsdInteger,-                        Swish.HaskellRDF.N3Formatter,-                        Swish.HaskellRDF.N3Parser,-                        Swish.HaskellRDF.ParsecLanguage,- -- YOH ADRIAN GHC EXTENSION??                       Swish.HaskellRDF.OwlAbstractSyntax,-                        Swish.HaskellRDF.Proof,-                        Swish.HaskellRDF.RDFDatatype,-                        Swish.HaskellRDF.RDFDatatypeXsdInteger,-                        Swish.HaskellRDF.RDFDatatypeXsdString,-                        Swish.HaskellRDF.RDFGraph,-                        Swish.HaskellRDF.RDFGraphShowM,-                        Swish.HaskellRDF.RDFProofContext,-                        Swish.HaskellRDF.RDFProof,-                        Swish.HaskellRDF.RDFQuery,-                        Swish.HaskellRDF.RDFRuleset,-                        Swish.HaskellRDF.Ruleset-                        Swish.HaskellRDF.SwishCommands-                        Swish.HaskellRDF.SwishMain-                        Swish.HaskellRDF.SwishMonad-                        Swish.HaskellRDF.SwishScript-                        Swish.HaskellRDF.VarBinding-                        Swish.HaskellRDF.Vocabulary-                        Swish.HaskellRDF.Sort.AdaptiveHeapSort--- WNH                         Swish.HaskellRDF.Sort.Benchmark-                        Swish.HaskellRDF.Sort.BraunHeap-                        Swish.HaskellRDF.Sort.CartesianTree-                        Swish.HaskellRDF.Sort.DigitalSort-                        Swish.HaskellRDF.Sort.FingerSearchtree-                        Swish.HaskellRDF.Sort.Force-                        Swish.HaskellRDF.Sort.HeapSort--- WNH                        Swish.HaskellRDF.Sort.Killer-                        Swish.HaskellRDF.Sort.LibBase-                        Swish.HaskellRDF.Sort.ListLib--- WNH                        Swish.HaskellRDF.Sort.Main   -                        Swish.HaskellRDF.Sort.MargeSort-                        Swish.HaskellRDF.Sort.MergeSort-                        Swish.HaskellRDF.Sort.PairingHeap--- WNH                       Swish.HaskellRDF.Sort.QuickSortInPlace-                        Swish.HaskellRDF.Sort.QuickSort--- WNH                        Swish.HaskellRDF.Sort.RandomLib---                        Swish.HaskellRDF.Sort.RandomMonad-                        Swish.HaskellRDF.Sort.RedBlackTree-                        Swish.HaskellRDF.Sort.SplaySort-                        Swish.HaskellRDF.Sort.Squiggol-                        Swish.HaskellRDF.Sort.Stable--- WNH same prob QuickSortInPlace                        Swish.HaskellRDF.Sort.SuffixArrays--- WNH                         Swish.HaskellRDF.Sort.TestData-                        Swish.HaskellUtils.AccumulateM-                        Swish.HaskellUtils.DateTime-                        Swish.HaskellUtils.ErrorM-                        Swish.HaskellUtils.FunctorM-                        Swish.HaskellUtils.ListHelpers-                        Swish.HaskellUtils.LookupMap-                        Swish.HaskellUtils.MiscHelpers-                        Swish.HaskellUtils.Namespace-                        Swish.HaskellUtils.Parse-                        Swish.HaskellUtils.ParseURI-                        Swish.HaskellUtils.PartOrderedCollection-                        Swish.HaskellUtils.ProcessURI-                        Swish.HaskellUtils.QName---   COMEBCK!!!!                     Swish.HaskellUtils.RegexParser-                        Swish.HaskellUtils.ShowM-                        Swish.HaskellUtils.TestHelpers-                        Swish.HaskellUtils.TraceHelpers-                         Swish.HaskellUtils.Network.URI--   extensions:          CPP, ParallelListComp-   ghc-options:         -Wall -fexcess-precision -funbox-strict-fields -auto-all+   Build-Depends:+      base >=3 && < 5,+      binary == 0.5.*,+      bytestring == 0.9.*,+      containers == 0.3.*,+      array == 0.3.*,+      parallel == 2.2.*,+      parsec == 2.1.*,+      random == 1.0.*,+      old-time == 1.0.*,+      mtl >= 1 && < 3,+      HUnit == 1.2.*,+      network >= 2.2 && < 2.4,+      directory >= 1.0 && <= 1.1,+      filepath >= 1.1 && <= 1.2+   Exposed-Modules:+      Swish.RDF.BuiltInDatatypes+      Swish.RDF.BuiltInMap+      Swish.RDF.BuiltInRules+      Swish.RDF.ClassRestrictionRule+      Swish.RDF.Datatype+      Swish.RDF.GraphClass+      Swish.RDF.GraphMatch+      Swish.RDF.GraphMem+      Swish.RDF.GraphPartition+      Swish.RDF.MapXsdInteger+      Swish.RDF.NTFormatter+      Swish.RDF.NTParser+      Swish.RDF.N3Formatter+      Swish.RDF.N3Parser+      Swish.RDF.Proof+      Swish.RDF.RDFDatatype+      Swish.RDF.RDFDatatypeXsdInteger+      Swish.RDF.RDFDatatypeXsdString+      Swish.RDF.RDFGraph+      Swish.RDF.RDFGraphShowM+      Swish.RDF.RDFParser+      Swish.RDF.RDFProof+      Swish.RDF.RDFProofContext+      Swish.RDF.RDFQuery+      Swish.RDF.RDFRuleset+      Swish.RDF.RDFVarBinding+      Swish.RDF.Rule+      Swish.RDF.Ruleset+      Swish.RDF.SwishCommands+      Swish.RDF.SwishMain+      Swish.RDF.SwishMonad+      Swish.RDF.SwishScript+      Swish.RDF.VarBinding+      Swish.RDF.Vocabulary+      Swish.Utils.DateTime+      Swish.Utils.ListHelpers+      Swish.Utils.LookupMap+      Swish.Utils.MiscHelpers+      Swish.Utils.Namespace+      Swish.Utils.PartOrderedCollection+      Swish.Utils.QName+      Swish.Utils.ShowM+      Swish.Utils.TraceHelpers +   other-modules:+      -- Paths_swish +   ghc-options:+      -Wall -fno-warn-orphans  Executable         BuiltInMapTest-   Main-Is:        Swish/HaskellRDF/BuiltInMapTest.hs-   Other-Modules:  Swish.HaskellRDF.BuiltInMap-                   Swish.HaskellRDF.RDFDatatypeXsdInteger-                   Swish.HaskellRDF.Ruleset-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellUtils.ListHelpers-----   YOH ADRIAN QNAME ISSUES Executable         ClassRestrictionRuleTest---   YOH ADRIAN QNAME ISSUES    Main-Is:        Swish/HaskellRDF/ClassRestrictionRuleTest.hs---   YOH ADRIAN QNAME ISSUES    Other_Modules:  Swish.HaskellRDF.ClassRestrictionRule---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFGraph---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFRuleset---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Ruleset---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Rule---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFDatatype---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Datatype---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellUtils.Namespace---   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Dfa+   Main-Is:        tests/BuiltInMapTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         GraphPartitionTest-   Main-Is:        Swish/HaskellRDF/GraphPartitionTest.hs-   Other-Modules:  Swish.HaskellRDF.GraphPartition-                   Swish.HaskellRDF.GraphClass-                   Swish.HaskellUtils.TestHelpers-                   Swish.HaskellUtils.ListHelpers+   Main-Is:        tests/GraphPartitionTest.hs +   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans+ Executable         GraphTest-   Main-Is:        Swish/HaskellRDF/GraphTest.hs-   Other-Modules:  Swish.HaskellUtils.ListHelpers-                   Swish.HaskellUtils.MiscHelpers-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellRDF.GraphClass-                   Swish.HaskellRDF.GraphMem-                   Swish.HaskellRDF.GraphMatch+   Main-Is:        tests/GraphTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans +Executable         NTTest+   Main-Is:        tests/NTTest.hs+   if !flag(tests)+      buildable: False++   if flag(hpc)+      ghc-options: -fhpc++   ghc-options:+      -Wall -fno-warn-orphans+ Executable         N3ParserTest-   Main-Is:        Swish/HaskellRDF/N3ParserTest.hs-   Other-Modules:  Swish.HaskellRDF.N3Parser-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellUtils.QName-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellRDF.GraphClass+   Main-Is:        tests/N3ParserTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         N3FormatterTest-   Main-Is:        Swish/HaskellRDF/N3FormatterTest.hs-   Other-Modules:  Swish.HaskellRDF.N3Formatter-                   Swish.HaskellRDF.N3Parser-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellUtils.QName-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellRDF.GraphClass-                   Swish.HaskellUtils.ErrorM+   Main-Is:        tests/N3FormatterTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         RDFDatatypeXsdIntegerTest-   Main-Is:        Swish/HaskellRDF/RDFDatatypeXsdIntegerTest.hs-   Other-Modules:  Swish.HaskellRDF.RDFDatatypeXsdInteger-                   Swish.HaskellRDF.RDFRuleset-                   Swish.HaskellRDF.RDFVarBinding-                   Swish.HaskellRDF.RDFDatatype-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellRDF.ClassRestrictionRule-                   Swish.HaskellRDF.MapXsdInteger-                   Swish.HaskellRDF.Datatype-                   Swish.HaskellRDF.Ruleset-                   Swish.HaskellRDF.Rule-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellRDF.Vocabulary -                   Swish.HaskellRDF.VarBinding+   Main-Is:        tests/RDFDatatypeXsdIntegerTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         RDFGraphTest-   Main-Is:        Swish/HaskellRDF/RDFGraphTest.hs-   Other-Modules:  Swish.HaskellUtils.FunctorM-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellUtils.ListHelpers-                   Swish.HaskellRDF.GraphClass-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellUtils.QName-                   Swish.HaskellRDF.RDFGraph  -                   Swish.HaskellRDF.Vocabulary  +   Main-Is:        tests/RDFGraphTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         RDFProofContextTest-   Main-Is:        Swish/HaskellRDF/RDFProofContextTest.hs-   Other-Modules:  Swish.HaskellRDF.BuiltInMap-                   Swish.HaskellRDF.RDFProofContext-                   Swish.HaskellRDF.RDFProof-                   Swish.HaskellRDF.RDFRuleset-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellRDF.RDFGraphShowM-                   Swish.HaskellRDF.Proof-                   Swish.HaskellRDF.Ruleset-                   Swish.HaskellRDF.Rule-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellUtils.LookupMap-                   Swish.HaskellRDF.Vocabulary+   Main-Is:        tests/RDFProofContextTest.hs+   if !flag(tests)+      buildable: False                     +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans -Executable         RDFProofText-   Main-Is:        Swish/HaskellRDF/RDFProofTest.hs-   Other-Modules:  Swish.HaskellRDF.RDFProof-                   Swish.HaskellRDF.RDFQuery-                   Swish.HaskellRDF.RDFVarBinding-                   Swish.HaskellRDF.RDFRuleset-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellRDF.VarBinding-                   Swish.HaskellRDF.Rule-                   Swish.HaskellUtils.Namespace+Executable         RDFProofTest+   Main-Is:        tests/RDFProofTest.hs+   if !flag(tests)+      buildable: False                      +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         RDFQueryTest-   Main-Is:        Swish/HaskellRDF/RDFQueryTest.hs-   Other-Modules:  Swish.HaskellRDF.RDFQuery-                   Swish.HaskellRDF.RDFVarBinding-                   Swish.HaskellRDF.RDFGraph -                   Swish.HaskellUtils.Namespace-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellRDF.N3Parser-                   Swish.HaskellUtils.QName-                   Swish.HaskellUtils.ListHelpers-                   Swish.HaskellUtils.ErrorM+   Main-Is:        tests/RDFQueryTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         RDFRulesetTest-   Main-Is:        Swish/HaskellRDF/RDFRulesetTest.hs-   Other-Modules:  Swish.HaskellRDF.RDFRuleset-                   Swish.HaskellRDF.RDFQuery-                   Swish.HaskellRDF.RDFVarBinding-                   Swish.HaskellRDF.RDFGraph-                   Swish.HaskellRDF.Ruleset-                   Swish.HaskellRDF.Rule-                   Swish.HaskellUtils.Namespace-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellUtils.QName+   Main-Is:        tests/RDFRulesetTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         VarBindingTest-   Main-Is:        Swish/HaskellRDF/VarBindingTest.hs-   Other-Modules:  Swish.HaskellRDF.VarBinding-                   Swish.HaskellRDF.Vocabulary-                   Swish.HaskellUtils.ListHelpers+   Main-Is:        tests/VarBindingTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         LookupMapTest-   Main-Is:        Swish/HaskellUtils/LookupMapTest.hs-   Other-Modules:  Swish.HaskellUtils.LookupMap-                   Swish.HaskellUtils.ListHelpers----Executable         ParseTest-   Main-Is:        Swish/HaskellUtils/ParseTest.hs-   Other-Modules:  Swish.HaskellUtils.Parse----Executable         ParseURITest-   Main-Is:        Swish/HaskellUtils/ParseURITest.hs-   Other-Modules:  Swish.HaskellUtils.ParseURITest-                   Swish.HaskellUtils.Parse+   Main-Is:        tests/LookupMapTest.hs+   if !flag(tests)+      buildable: False +   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans  Executable         QNameTest-   Main-Is:        Swish/HaskellUtils/QNameTest.hs-   Other-Modules:  Swish.HaskellUtils.QName----Executable         URITest -   Main-Is:        Swish/HaskellUtils/URITest.hs-   Other-Modules:  Swish.HaskellUtils.Parse-                   Swish.HaskellUtils.ProcessURI----Executable         SwishTest-   Main-Is:        Swish/HaskellRDF/SwishTest.hs-   Other-Modules:  Swish.HaskellRDF.SwishMain--+   Main-Is:        tests/QNameTest.hs+   if !flag(tests)+      buildable: False - Executable         SwishTestAll-    Main-Is:        Swish/HaskellRDF/SwishTestAll.hs-    Other-Modules:  Swish.HaskellUtils.DateTimeTest-                    Swish.HaskellUtils.ParseTest-                    Swish.HaskellUtils.LookupMapTest-                    Swish.HaskellUtils.NamespaceTest-                    Swish.HaskellUtils.URITest-                    Swish.HaskellUtils.ParseURITest-                    Swish.HaskellRDF.GraphTest-                    Swish.HaskellRDF.VarBindingTest-                    Swish.HaskellRDF.RDFGraphTest-                    Swish.HaskellRDF.RDFQueryTest-                    Swish.HaskellRDF.RDFProofTest-                    Swish.HaskellRDF.RDFRulesetTest-                    Swish.HaskellRDF.RDFProofContextTest-                    Swish.HaskellRDF.RDFDatatypeXsdIntegerTest-                    Swish.HaskellRDF.ClassRestrictionRuleTest-                    Swish.HaskellRDF.N3FormatterTest-                    Swish.HaskellRDF.N3ParserTest-                    Swish.HaskellRDF.BuiltInMapTest-                    Swish.HaskellRDF.SwishTest+   if flag(hpc)+      ghc-options: -fhpc +   ghc-options:+      -Wall -fno-warn-orphans + -- we do not have the data files to run this test+ Executable         SwishTest+   Main-Is:        tests/SwishTest.hs  Executable         Swish-   Main-Is:        Swish/HaskellRDF/Swish.hs-   Other-Modules:  Swish.HaskellRDF.SwishMain+   Main-Is:        src/Swish.hs+   Other-Modules:  Paths_swish +   ghc-options:+      -Wall -fno-warn-orphans
+ tests/BuiltInMapTest.hs view
@@ -0,0 +1,288 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  BuiltInMapTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for accessing built-in variable+--  binding modifiers.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.BuiltInMap+    ( findRDFOpenVarBindingModifier+    , findRDFDatatype+    , rdfRulesetMap+    , allRulesets+    )++import Swish.RDF.RDFDatatypeXsdInteger+    ( typeNameXsdInteger, namespaceXsdInteger+    )++import Swish.RDF.Ruleset+    ( getMaybeContextAxiom+    , getMaybeContextRule+    )++import Swish.Utils.Namespace+    ( ScopedName(..) )++import Swish.RDF.Vocabulary+    ( swishName+    , scopeRDF+    , scopeRDFS+    , scopeRDFD+    , namespaceXsdType+    )++import Swish.Utils.LookupMap+    ( mapFindMaybe )++import Swish.Utils.ListHelpers+    ( equiv )++import Test.HUnit+    ( Test(TestCase,TestList)+    , Assertion+    , assertBool, assertEqual, assertFailure+    , runTestTT, runTestText, putTextToHandle+    )++import System.IO+    ( IOMode(WriteMode)+    , openFile, hClose+    )++import Control.Monad (unless)+import Data.Maybe (isJust)+++------------------------------------------------------------+--  Test case helpers+------------------------------------------------------------++assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion+assertMember preface expected actual =+  unless (expected `elem` actual ) (assertFailure msg)+  where msg = (if null preface then "" else preface ++ "\n") +++             "expected: " ++ show expected ++ "\nbut got: " ++ show actual++test :: String -> Bool -> Test+test lab bv =+    TestCase ( assertBool ("test:"++lab) bv )++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testElem :: (Eq a, Show a) => String -> a -> [a] -> Test+testElem lab a1 as =+    TestCase ( assertMember ("testElem:"++lab) a1 as )++testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test+testLe lab eq a1 a2 =+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )++-- Test for Just x or Nothing++testJust :: String -> Maybe a -> Test+testJust lab av =+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )++testNothing :: String -> Maybe a -> Test+testNothing lab av =+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )++-- Compare lists and lists of lists and Maybe lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+    show (ListTest a) = show a++data MaybeListTest a = MaybeListTest (Maybe [a])++instance (Eq a) => Eq (MaybeListTest a) where+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2+    MaybeListTest Nothing   == MaybeListTest Nothing   = True+    _                       == _                       = False++instance (Show a) => Show (MaybeListTest a) where+    show (MaybeListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test+testEqvEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest $ map ListTest a1+        ma2 = ListTest $ map ListTest a2++testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test+testHasEqv lab a1 a2 =+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest a1+        ma2 = map ListTest a2++testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test+testMaybeEqv lab a1 a2 =+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )+    where+        ma1 = (MaybeListTest a1)+        ma2 = (MaybeListTest a2)++------------------------------------------------------------+--  Test finding built-in variable binding modifiers+------------------------------------------------------------++testVarMod01, testVarMod02, testVarMod03, testVarMod04, +  testVarMod05, testVarMod06, testVarMod07 :: Test++testVarMod01 = testJust "testVarMod01" $+    findRDFOpenVarBindingModifier (swishName "rdfVarBindingUriRef")+testVarMod02 = testJust "testVarMod02" $+    findRDFOpenVarBindingModifier (swishName "rdfVarBindingDatatyped")+testVarMod03 = testJust "testVarMod03" $+    findRDFOpenVarBindingModifier (swishName "varFilterNE")+testVarMod04 = testJust "testVarMod04" $+    findRDFOpenVarBindingModifier (swishName "nullVarBindingModify")+testVarMod05 = testJust "testVarMod05" $+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "abs")+testVarMod06 = testJust "testVarMod06" $+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "divmod")+testVarMod07 = testJust "testVarMod07" $+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "ge")++testVarModSuite :: Test+testVarModSuite = TestList+    [ testVarMod01, testVarMod02, testVarMod03, testVarMod04+    , testVarMod05, testVarMod06, testVarMod07+    ]++------------------------------------------------------------+--  Test finding built-in datatypes+------------------------------------------------------------++testDatatype01 :: Test+testDatatype01 = testJust "testDatatype01" $ findRDFDatatype typeNameXsdInteger++testDatatypeSuite :: Test+testDatatypeSuite = TestList+    [ testDatatype01+    ]++------------------------------------------------------------+--  Test finding built-in rulesets+------------------------------------------------------------++testRuleset01 :: Test+testRuleset01 = testJust "testRuleset01" $+    mapFindMaybe scopeRDF rdfRulesetMap++testRulesetSuite :: Test+testRulesetSuite = TestList+    [ testRuleset01+    ]++------------------------------------------------------------+--  Test finding arbitrary axioms and rules+------------------------------------------------------------++testFindAxiom01, testFindAxiom02, testFindAxiom03 :: Test++testFindAxiom01 = testJust "testFindAxiom01" $+    getMaybeContextAxiom (ScopedName scopeRDF "a1") allRulesets+testFindAxiom02 = testJust "testFindAxiom02" $+    getMaybeContextAxiom (ScopedName scopeRDFS "a01") allRulesets+testFindAxiom03 = testJust "testFindAxiom03" $+    getMaybeContextAxiom (ScopedName (namespaceXsdType "integer") "dt")+        allRulesets++testFindAxiomSuite :: Test+testFindAxiomSuite = TestList+    [ testFindAxiom01, testFindAxiom02, testFindAxiom03+    ]++testFindRule01, testFindRule02, testFindRule03, testFindRule04 :: Test++testFindRule01 = testJust "testFindRule01" $+    getMaybeContextRule (ScopedName scopeRDF "r1") allRulesets+testFindRule02 = testJust "testFindRule02" $+    getMaybeContextRule (ScopedName scopeRDFS "r1") allRulesets+testFindRule03 = testJust "testFindRule03" $+    getMaybeContextRule (ScopedName scopeRDFD "r1") allRulesets+testFindRule04 = testJust "testFindRule04" $+    getMaybeContextRule (ScopedName (namespaceXsdType "integer") "Abs")+        allRulesets++testFindRuleSuite :: Test+testFindRuleSuite = TestList+    [ testFindRule01, testFindRule02, testFindRule03, testFindRule04+    ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+    [ testVarModSuite+    , testDatatypeSuite+    , testRulesetSuite+    , testFindAxiomSuite+    , testFindRuleSuite+    ]++main :: IO ()+main = runTestTT allTests >> return ()++runTestFile :: Test -> IO ()+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    _ <- runTestText (putTextToHandle h False) t+    hClose h+    +{-+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/GraphPartitionTest.hs view
@@ -0,0 +1,574 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphPartitionTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for graph partitioning logic.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.GraphPartition+    ( PartitionedGraph(..), getArcs+    , GraphPartition(..), node+    , partitionGraph, comparePartitions+    )++import Swish.RDF.GraphClass (Arc(..))++import Swish.RDF.GraphMem (LabelMem(..))++import Swish.Utils.ListHelpers (equiv)++import Test.HUnit (Test(TestCase, TestList),+                   assertEqual, assertBool,+                   runTestTT)++------------------------------------------------------------+--  Test case helpers+------------------------------------------------------------++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testNe :: (Eq a, Show a) => String -> a -> a -> Test+testNe lab a1 a2 =+    TestCase ( assertBool ("testNe:"++lab) (a1 /= a2) )++-- Compare lists and lists of lists and Maybe lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+    show (ListTest a) = show a++data MaybeListTest a = MaybeListTest (Maybe [a])++instance (Eq a) => Eq (MaybeListTest a) where+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2+    MaybeListTest Nothing   == MaybeListTest Nothing   = True+    _                       == _                       = False++instance (Show a) => Show (MaybeListTest a) where+    show (MaybeListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++testNotEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testNotEqv lab a1 a2 =+    TestCase ( assertBool ("testEqv:"++lab) (ListTest a1 /= ListTest a2) )++------------------------------------------------------------+--  Basic GraphPartition tests+------------------------------------------------------------++gp1, gp2, gp3, gp4, gp5 :: PartitionedGraph LabelMem++gp1 = PartitionedGraph [ p11 ]+gp2 = PartitionedGraph [ p11, p12 ]+gp3 = PartitionedGraph [ p11, p13 ]+gp4 = PartitionedGraph [ p11, p14 ]+gp5 = PartitionedGraph [ p11, p12, p15 ]++p11, p12, p13, p14, p15 :: GraphPartition LabelMem++p11 = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]+p12 = PartSub (LF "s2") [ (LF "p21",PartObj (LF "o21"))+                        , (LF "p22",PartObj (LF "o22"))+                        ]+p13 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))+                        , (LF "p32",p12)+                        , (LF "p33",PartObj (LF "s3"))+                        ]+p14 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))+                        , (LF "p33",PartObj (LF "s3"))+                        , (LF "p32",p12)+                        ]+p15 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))+                        , (LF "p32",PartObj (LF "s2"))+                        , (LF "p33",PartObj (LF "s3"))+                        ]++ga1, ga2, ga3, ga4, ga5 :: [Arc LabelMem]++ga1 =+    [ Arc (LF "s1") (LF "p11") (LF "o11")+    ]++ga2 =+    [ Arc (LF "s1") (LF "p11") (LF "o11")+    , Arc (LF "s2") (LF "p21") (LF "o21")+    , Arc (LF "s2") (LF "p22") (LF "o22")+    ]++ga3 =+    [ Arc (LF "s1") (LF "p11") (LF "o11")+    , Arc (LF "s3") (LF "p31") (LF "o31")+    , Arc (LF "s3") (LF "p32") (LF "s2")+    , Arc (LF "s2") (LF "p21") (LF "o21")+    , Arc (LF "s2") (LF "p22") (LF "o22")+    , Arc (LF "s3") (LF "p33") (LF "s3")+    ]+ga4 =+    [ Arc (LF "s1") (LF "p11") (LF "o11")+    , Arc (LF "s3") (LF "p31") (LF "o31")+    , Arc (LF "s3") (LF "p33") (LF "s3")+    , Arc (LF "s3") (LF "p32") (LF "s2")+    , Arc (LF "s2") (LF "p21") (LF "o21")+    , Arc (LF "s2") (LF "p22") (LF "o22")+    ]+ga5 =+    [ Arc (LF "s1") (LF "p11") (LF "o11")+    , Arc (LF "s2") (LF "p21") (LF "o21")+    , Arc (LF "s2") (LF "p22") (LF "o22")+    , Arc (LF "s3") (LF "p31") (LF "o31")+    , Arc (LF "s3") (LF "p32") (LF "s2")+    , Arc (LF "s3") (LF "p33") (LF "s3")+    ]++testBasic01, testBasic02, testBasic03, testBasic04, testBasic05 :: Test ++testBasic01 = testEq "testBasic01" gp1 gp1+testBasic02 = testEq "testBasic02" gp2 gp2+testBasic03 = testEq "testBasic03" gp3 gp3+testBasic04 = testEq "testBasic04" gp4 gp4+testBasic05 = testEq "testBasic05" gp5 gp5++testBasic06, testBasic07 :: Test+testBasic06 = testNe "testBasic06" gp2 gp3+testBasic07 = testNe "testBasic07" gp3 gp4++testBasic11, testBasic12, testBasic13, testBasic14, testBasic15 :: Test ++testBasic11 = testEq "testBasic11"+        "PartitionedGraph [(!s1 !p11 !o11)]"+        (show gp1)+testBasic12 = testEq "testBasic12"+        ( "PartitionedGraph "+++          "[(!s1 !p11 !o11)"+++          ",(!s2 !p21 !o21 ; !p22 !o22)"+++          "]"+        )+        (show gp2)+testBasic13 = testEq "testBasic13"+        ( "PartitionedGraph "+++          "[(!s1 !p11 !o11)"+++          ",(!s3 !p31 !o31 ; !p32 (!s2 !p21 !o21 ; !p22 !o22) ; !p33 !s3)"+++          "]"+        )+        (show gp3)+testBasic14 = testEq "testBasic14"+        ( "PartitionedGraph "+++          "[(!s1 !p11 !o11)"+++          ",(!s3 !p31 !o31 ; !p33 !s3 ; !p32 (!s2 !p21 !o21 ; !p22 !o22))"+++          "]"+        )+        (show gp4)+testBasic15 = testEq "testBasic15"+        ( "PartitionedGraph "+++          "[(!s1 !p11 !o11)"+++          ",(!s2 !p21 !o21 ; !p22 !o22)"+++          ",(!s3 !p31 !o31 ; !p32 !s2 ; !p33 !s3)"+++          "]"+        )+        (show gp5)++testBasic21, testBasic22, testBasic23, testBasic24, testBasic25 :: Test ++testBasic21 = testEq "testBasic21" (LF "s1") (node p11)+testBasic22 = testEq "testBasic22" (LF "s2") (node p12)+testBasic23 = testEq "testBasic23" (LF "s3") (node p13)+testBasic24 = testEq "testBasic24" (LF "s3") (node p14)+testBasic25 = testEq "testBasic25" (LF "s3") (node p15)++testBasic31, testBasic32, testBasic33, testBasic34, testBasic35,+  testBasic36, testBasic37, testBasic38 :: Test ++testBasic31 = testEq "testBasic31" ga1 (getArcs gp1)+testBasic32 = testEq "testBasic32" ga2 (getArcs gp2)+testBasic33 = testEq "testBasic33" ga3 (getArcs gp3)+testBasic34 = testEq "testBasic34" ga4 (getArcs gp4)+testBasic35 = testEq "testBasic35" ga5 (getArcs gp5)+testBasic36 = testNotEqv "testBasic36" (getArcs gp2) (getArcs gp3)+testBasic37 = testEqv    "testBasic37" (getArcs gp3) (getArcs gp4)+testBasic38 = testEqv    "testBasic38" (getArcs gp3) (getArcs gp5)++testBasicSuite :: Test+testBasicSuite = TestList+    [ testBasic01+    , testBasic02+    , testBasic03+    , testBasic04+    , testBasic05+    , testBasic06+    , testBasic07+    , testBasic11+    , testBasic12+    , testBasic13+    , testBasic14+    , testBasic15+    , testBasic21+    , testBasic22+    , testBasic23+    , testBasic24+    , testBasic25+    , testBasic31+    , testBasic32+    , testBasic33+    , testBasic34+    , testBasic35+    , testBasic36+    , testBasic37+    , testBasic38+    ]++------------------------------------------------------------+--  Creating GraphPartition tests+------------------------------------------------------------++pa1, pa2, pa3, pa4, pa5, pa6 :: [Arc LabelMem]++pa1 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    ]++pa2 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    , Arc (LF "s2") (LF "p1") (LF "o21")+    , Arc (LF "s2") (LF "p2") (LF "o22")+    ]++pa3 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    , Arc (LF "s2") (LF "p1") (LF "o21")+    , Arc (LF "s2") (LF "p2") (LF "o22")+    , Arc (LV "b3") (LF "p") (LF "o31")+    , Arc (LV "b3") (LF "p") (LF "s2")+    , Arc (LV "b3") (LF "p") (LV "b3")+    ]++pa4 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    , Arc (LF "s2") (LF "p1") (LF "o21")+    , Arc (LF "s2") (LF "p2") (LF "o22")+    , Arc (LV "b3") (LF "p") (LF "o31")+    , Arc (LV "b3") (LF "p") (LF "s2")+    , Arc (LV "b3") (LF "p") (LV "b3")+    , Arc (LV "b3") (LF "p") (LV "b4")+    , Arc (LV "b4") (LF "p") (LF "s2")+    , Arc (LV "b4") (LF "p") (LV "b3")+    ]++pa5 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    , Arc (LF "s2") (LF "p1") (LF "o21")+    , Arc (LF "s2") (LF "p2") (LF "o22")+    , Arc (LV "b3") (LF "p") (LF "o31")+    , Arc (LV "b3") (LF "p") (LF "s2")+    , Arc (LV "b3") (LF "p") (LV "b3")+    , Arc (LV "b3") (LF "p") (LV "b4")+    , Arc (LV "b4") (LF "p") (LF "s2")+    , Arc (LV "b4") (LF "p") (LV "b3")+    , Arc (LV "b5a") (LF "p") (LV "b5b")+    , Arc (LV "b5b") (LF "p") (LV "b5c")+    , Arc (LV "b5c") (LF "p") (LV "b5a")+    ]++pa6 =+    [ Arc (LF "s1") (LF "p") (LF "o11")+    , Arc (LF "s2") (LF "p1") (LF "o21")+    , Arc (LF "s2") (LF "p2") (LF "o22")+    , Arc (LV "b3") (LF "p") (LF "o31")+    , Arc (LV "b3") (LF "p") (LF "s2")+    , Arc (LV "b3") (LF "p") (LV "b3")+    , Arc (LV "b3") (LF "p") (LV "b4")+    , Arc (LV "b4") (LF "p") (LF "s2")+    , Arc (LV "b4") (LF "p") (LV "b3")+    , Arc (LV "b4") (LF "p") (LV "b5b")+    , Arc (LV "b5a") (LF "p") (LV "b5b")+    , Arc (LV "b5b") (LF "p") (LV "b5c")+    , Arc (LV "b5c") (LF "p") (LV "b5a")+    ]++pp1, pp2f, pp2r, pp3f, pp3r, pp4f, pp4r, pp5f, pp5r,+  pp6f, pp6r :: PartitionedGraph LabelMem++pp1  = PartitionedGraph [ ps1 ]+pp2f = PartitionedGraph [ ps1,  ps2f ]+pp2r = PartitionedGraph [ ps2r, ps1 ]+pp3f = PartitionedGraph [ ps1,  ps2f, pb3f ]+pp3r = PartitionedGraph [ ps2r, ps1,  pb3r ]+pp4f = PartitionedGraph [ ps1,  ps2f, pb3af ]+pp4r = PartitionedGraph [ ps2r, ps1,  pb3ar ]+pp5f = PartitionedGraph [ ps1,  ps2f, pb3af, pb5a1 ]+pp5r = PartitionedGraph [ ps2r, ps1,  pb3ar, pb5c3 ]+pp6f = PartitionedGraph [ ps1,  ps2f, pb3bf, pb5b2 ]+pp6r = PartitionedGraph [ ps2r, ps1,  pb5b2, pb3br ]++ps1, ps2f, ps2r, pb3f, pb3r, pb3af, pb3ar,+  pb4af, pb4ar :: GraphPartition LabelMem++ps1  = PartSub (LF "s1") [ (LF "p",PartObj (LF "o11")) ]+ps2f = PartSub (LF "s2") [ (LF "p1",PartObj (LF "o21"))+                         , (LF "p2",PartObj (LF "o22"))+                         ]+ps2r = PartSub (LF "s2") [ (LF "p2",PartObj (LF "o22"))+                         , (LF "p1",PartObj (LF "o21"))+                         ]+pb3f = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))+                         , (LF "p",PartObj (LF "s2"))+                         , (LF "p",PartObj (LV "b3"))+                         ]+pb3r = PartSub (LV "b3") [ (LF "p",PartObj (LV "b3"))+                         , (LF "p",PartObj (LF "s2"))+                         , (LF "p",PartObj (LF "o31"))+                         ]++pb3af = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))+                          , (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",pb4af)+                          ]+pb3ar = PartSub (LV "b3") [ (LF "p",pb4ar)+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LF "o31"))+                          ]+pb4af = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LV "b3"))+                          ]+pb4ar = PartSub (LV "b4") [ (LF "p",PartObj (LV "b3"))+                          , (LF "p",PartObj (LF "s2"))+                          ]+        +pb5a1, pb5b1, pb5c1 :: GraphPartition LabelMem++pb5a1 = PartSub (LV "b5a") [ (LF "p",pb5b1) ]+pb5b1 = PartSub (LV "b5b") [ (LF "p",pb5c1) ]+pb5c1 = PartSub (LV "b5c") [ (LF "p",PartObj (LV "b5a")) ]++pb3bf, pb3br, pb4bf, pb4br :: GraphPartition LabelMem++pb3bf = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))+                          , (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",pb4bf)+                          ]+pb3br = PartSub (LV "b3") [ (LF "p",pb4br)+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LF "o31"))+                          ]+pb4bf = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",PartObj (LV "b5b"))+                          ]+pb4br = PartSub (LV "b4") [ (LF "p",PartObj (LV "b5b"))+                          , (LF "p",PartObj (LV "b3"))+                          , (LF "p",PartObj (LF "s2"))+                          ]++pb5a2, pb5b2, pb5c2 :: GraphPartition LabelMem++pb5a2 = PartSub (LV "b5a") [ (LF "p",PartObj (LV "b5b")) ]+pb5b2 = PartSub (LV "b5b") [ (LF "p",pb5c2) ]+pb5c2 = PartSub (LV "b5c") [ (LF "p",pb5a2) ]++pb5a3, pb5b3, pb5c3 :: GraphPartition LabelMem++pb5a3 = PartSub (LV "b5a") [ (LF "p",pb5b3) ]+pb5b3 = PartSub (LV "b5b") [ (LF "p",PartObj (LV "b5c")) ]+pb5c3 = PartSub (LV "b5c") [ (LF "p",pb5a3) ]++testPartition11, testPartition12, testPartition13, testPartition14, testPartition15, +  testPartition16 :: Test++testPartition11 = testEq "testPartition11" pp1  (partitionGraph pa1)+testPartition12 = testEq "testPartition12" pp2f (partitionGraph pa2)+testPartition13 = testEq "testPartition13" pp3f (partitionGraph pa3)+testPartition14 = testEq "testPartition15" pp4f (partitionGraph pa4)+testPartition15 = testEq "testPartition14" pp5f (partitionGraph pa5)+testPartition16 = testEq "testPartition16" pp6f (partitionGraph pa6)++testPartition21, testPartition22, testPartition23, testPartition24, testPartition25, +  testPartition26 :: Test++testPartition21 = testEq "testPartition21" pp1  (partitionGraph $ reverse pa1)+testPartition22 = testEq "testPartition22" pp2r (partitionGraph $ reverse pa2)+testPartition23 = testEq "testPartition23" pp3r (partitionGraph $ reverse pa3)+testPartition24 = testEq "testPartition24" pp4r (partitionGraph $ reverse pa4)+testPartition25 = testEq "testPartition25" pp5r (partitionGraph $ reverse pa5)+testPartition26 = testEq "testPartition26" pp6r (partitionGraph $ reverse pa6)++testPartition31, testPartition32, testPartition33, testPartition34, testPartition35, +  testPartition36 :: Test++testPartition31 = testEqv "testPartition31" pa1  (getArcs pp1)+testPartition32 = testEqv "testPartition32" pa2  (getArcs pp2f)+testPartition33 = testEqv "testPartition33" pa3  (getArcs pp3f)+testPartition34 = testEqv "testPartition35" pa4  (getArcs pp4f)+testPartition35 = testEqv "testPartition34" pa5  (getArcs pp5f)+testPartition36 = testEqv "testPartition36" pa6  (getArcs pp6f)++testPartition41, testPartition42, testPartition43, testPartition44, testPartition45, +  testPartition46 :: Test++testPartition41 = testEqv "testPartition41" pa1  (getArcs pp1 )+testPartition42 = testEqv "testPartition42" pa2  (getArcs pp2r)+testPartition43 = testEqv "testPartition43" pa3  (getArcs pp3r)+testPartition44 = testEqv "testPartition44" pa4  (getArcs pp4r)+testPartition45 = testEqv "testPartition45" pa5  (getArcs pp5r)+testPartition46 = testEqv "testPartition46" pa6  (getArcs pp6r)++testPartition51, testPartition52, testPartition53, testPartition54, testPartition55, +  testPartition56, testPartition57, testPartition58, testPartition59 :: Test++testPartition51 = testEqv "testPartition51" []   (comparePartitions pp1  pp1)+testPartition52 = testEqv "testPartition52" []   (comparePartitions pp2f pp2r)+testPartition53 = testEqv "testPartition53" []   (comparePartitions pp3f pp3r)+testPartition54 = testEqv "testPartition54" []   (comparePartitions pp4f pp4r)+testPartition55 = testEqv "testPartition55" []   (comparePartitions pp5f pp5r)+testPartition56 = testEqv "testPartition56" []   (comparePartitions pp6f pp6r)+testPartition57 = testEqv "testPartition57"+        [(Nothing,Just $ PartSub (LV "b3") [(LF "p",pb4af)])]+        (comparePartitions pp3f pp4f)+testPartition58 = testEqv "testPartition58"+        [(Nothing,Just pb5a1)]+        (comparePartitions pp4f pp5f)+testPartition59 = testEqv "testPartition59"+        [(Nothing,Just $ PartSub (LV "b4") [(LF "p",PartObj (LV "b5b"))])]+        (comparePartitions pp5f pp6f)++testPartitionSuite :: Test+testPartitionSuite = TestList+    [ testPartition11+    , testPartition12+    , testPartition13+    , testPartition14+    , testPartition15+    , testPartition16+    , testPartition21+    , testPartition22+    , testPartition23+    , testPartition24+    , testPartition25+    , testPartition26+    , testPartition31+    , testPartition32+    , testPartition33+    , testPartition34+    , testPartition35+    , testPartition36+    , testPartition41+    , testPartition42+    , testPartition43+    , testPartition44+    , testPartition45+    , testPartition46+    , testPartition51+    , testPartition52+    , testPartition53+    , testPartition54+    , testPartition55+    , testPartition56+    , testPartition57+    , testPartition58+    , testPartition59+    ]+++------------------------------------------------------------+--  GraphPartition compare test with partial matching+------------------------------------------------------------++pgc1a, pgc1b :: PartitionedGraph LabelMem++pgc1a = PartitionedGraph [ c11, c12a ]+pgc1b = PartitionedGraph [ c11, c12b ]++c11, c12a, c12b, c13a, c13b :: GraphPartition LabelMem++c11  = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]+c12a = PartSub (LF "s2") [ (LF "p21",c13a)+                         , (LF "p22",PartObj (LF "o22"))+                         ]+c12b = PartSub (LF "s2") [ (LF "p22",PartObj (LF "o22"))+                         , (LF "p21",c13b)+                         ]+c13a = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))+                         , (LF "p33",PartObj (LF "o33a"))+                         ]+c13b = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))+                         , (LF "p33",PartObj (LF "o33b"))+                         ]+       +testCompare01 :: Test+testCompare01 = testEqv "testCompare01"+        [(Just (PartObj (LF "o33a")),Just (PartObj (LF "o33b")))]+        (comparePartitions pgc1a pgc1b)++testCompareSuite :: Test+testCompareSuite = TestList+    [ testCompare01+    ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+    [ testBasicSuite+    , testPartitionSuite+    , testCompareSuite+    ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/GraphTest.hs view
@@ -0,0 +1,1805 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  GraphTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines test cases for module Graph.+--+--------------------------------------------------------------------------------++module Main where++import Test.HUnit+      ( Test(TestCase,TestList,TestLabel),+        assertEqual, runTestTT )+import Data.List( elemIndex )+import Data.Maybe( fromJust )++import Swish.Utils.ListHelpers+import Swish.Utils.MiscHelpers+import Swish.RDF.GraphClass (Arc(..), LDGraph(..),+                             Label(..),+                             arcFromTriple,arcToTriple)+import Swish.RDF.GraphMem+import Swish.RDF.GraphMatch+      ( LabelMap, GenLabelMap(..), LabelEntry, +        EquivalenceClass,+        ScopedLabel(..), makeScopedLabel, makeScopedArc,+        LabelIndex, nullLabelVal, emptyMap,+        mapLabelIndex, {-mapLabelList,-} setLabelHash, newLabelMap,+        graphLabels, assignLabelMap, newGenerationMap,+        graphMatch1, equivalenceClasses+      )+import Swish.Utils.LookupMap+      ( LookupEntryClass(..), makeLookupMap+      , mapSortByVal+      )++default ( Int )++------------------------------------------------------------+-- Define some common values+------------------------------------------------------------++base1, base2, base3, base4 :: String++base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"++------------------------------------------------------------+--  Set, get graph arcs as lists of triples+------------------------------------------------------------++setArcsT :: (Swish.RDF.GraphClass.LDGraph lg lb) =>+            [(lb, lb, lb)] -> lg lb -> lg lb+setArcsT a = setArcs $ map arcFromTriple a++getArcsT :: (Swish.RDF.GraphClass.LDGraph lg lb) =>+            lg lb -> [(lb, lb, lb)]+getArcsT g = map arcToTriple $ getArcs g++toStatement :: a -> a -> a -> Arc a+toStatement s p o = Arc s p o++------------------------------------------------------------+--  Test class helper+------------------------------------------------------------++testeq :: (Show a, Eq a) => String -> a -> a -> Test+testeq lab req got =+    TestCase ( assertEqual ("test"++lab) req got )++testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test+testeqv lab req got =+    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )++------------------------------------------------------------+--  Label map and entry creation helpers+------------------------------------------------------------++tstLabelMap :: (Label lb) => Int -> [(lb,LabelIndex)] -> LabelMap lb+tstLabelMap gen lvs = LabelMap gen (makeLookupMap $ makeEntries lvs)++makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb]+makeEntries lvs = map newEntry lvs++labelMapSortByVal :: (Label lb) => LabelMap lb -> LabelMap lb+labelMapSortByVal (LabelMap gen lm) = LabelMap gen (mapSortByVal lm)++------------------------------------------------------------+--  Graph helper function tests+------------------------------------------------------------++-- select++testSelect :: String -> [Char] -> [Char] -> Test+testSelect lab = testeq ("Select"++lab )++isOne :: Int -> Bool+isOne = (1 ==)++testSelect01, testSelect02, testSelect03, testSelect04 :: Test+testSelect01 = testSelect "01"+                (select isOne [0,1,2,0,1,2] ['a','b','c','a','b','c'])+                ['b','b']+testSelect02 = testSelect "02"+                (select isOne [1,1,1,1,1,1] ['a','b','c','a','b','c'])+                ['a','b','c','a','b','c']+testSelect03 = testSelect "03"+                (select isOne [0,0,0,0,0,0] ['a','b','c','a','b','c'])+                []+testSelect04 = testSelect "04"+                (select isOne []            []                       )+                []++testSelectSuite :: Test+testSelectSuite = TestList+    [+    testSelect01, testSelect02, testSelect03, testSelect04+    ]++-- mapset++mf   :: Int -> Char+mf n = "_abcde" !! n++testMapset :: String -> [Int] -> [Char] -> Test+testMapset lab l1s l2s = testeq ("Mapset"++lab ) l2s (mapset mf l1s)++testMapsetSuite :: Test+testMapsetSuite = TestList+    [ testMapset "01" [0,1,2,3,4,5] ['_','a','b','c','d','e']+    , testMapset "02" [1,1,3,3,5,5] ['a','c','e']+    , testMapset "03" [5,4,3,2,1,0] ['e','d','c','b','a','_']+    , testMapset "04" []            []+    , testMapset "05" [1,2,3,4,5,0] ['a','b','c','d','e','_']+    ]++-- subset++testSubset :: String -> Bool -> [Int] -> [Int] -> Test+testSubset lab res l1s l2s = testeq ("Mapset"++lab ) res (l1s `subset` l2s)++testSubsetSuite :: Test+testSubsetSuite = TestList+    [ testSubset "01" True  [1,2,3]       [0,1,2,3,4,5]+    , testSubset "02" True  [5,3,1]       [0,1,2,3,4,5]+    , testSubset "03" True  [5,4,3,2,1,0] [0,1,2,3,4,5]+    , testSubset "04" True  []            []+    , testSubset "05" False [0,1,2,3,4,5] [1,2,3]+    , testSubset "06" False [0,1,2,3,4,5] [5,3,1]+    , testSubset "07" True  []            [1,2,3]+    , testSubset "08" False [1,2,3]       []+    ]++-- hash++testHash :: String -> Bool -> Int -> Int -> Test+testHash lab eq h1 h2 = testeq ("Hash"++lab ) eq (h1 == h2)++testHashEq :: String -> Int -> Int -> Test+testHashEq lab h1 h2  = testeq ("Hash"++lab ) h1 h2++testHashSuite :: Test+testHashSuite = TestList+    [ testHash "01" True  (hash 0 base1) (hash 0 base1)+    , testHash "02" True  (hash 2 "")    (hash 2 "")+    , testHash "03" False (hash 3 base1) (hash 3 base2)+    , testHash "04" False (hash 4 base1) (hash 5 base1)+    , testHash "05" False (hash 2 "")    (hash 3 "")+    , testHashEq "06"     1424775        (hash 3 base1)+    , testHashEq "07"     11801303       (hash 3 base2)+    ]++------------------------------------------------------------+--  Simple graph label tests+------------------------------------------------------------++testLabSuite :: Test+testLabSuite = TestList+    [ testeq "Lab01" False (labelIsVar lab1f)+    , testeq "Lab02" True  (labelIsVar lab1v)+    , testeq "Lab03" False (labelIsVar lab2f)+    , testeq "Lab04" True  (labelIsVar lab2v)++    , testeq "Lab05"  3436883 (labelHash 1 lab1f)+    , testeq "Lab06" 10955600 (labelHash 1 lab1v)+    , testeq "Lab07"  3436884 (labelHash 1 lab2f)+    , testeq "Lab08" 10955601 (labelHash 1 lab2v)++    , testeq "Lab09" "!lab1" (show lab1f)+    , testeq "Lab10" "?lab1" (show lab1v)+    , testeq "Lab11" "!lab2" (show lab2f)+    , testeq "Lab12" "?lab2" (show lab2v)++    , testeq "Lab13" "lab1" (getLocal lab1v)+    , testeq "Lab14" "lab2" (getLocal lab2v)+    , testeq "Lab15" lab1v  (makeLabel "lab1")+    , testeq "Lab16" lab2v  (makeLabel "lab2")+    ]++------------------------------------------------------------+--  Simple graph tests+------------------------------------------------------------++lab1f, lab1v, lab2f, lab2v :: LabelMem+lab1f = LF "lab1"+lab1v = LV "lab1"+lab2f = LF "lab2"+lab2v = LV "lab2"++gr1 :: GraphMem LabelMem+gr1 = GraphMem { arcs=[]::[Arc LabelMem] }++ga1 :: [(LabelMem, LabelMem, LabelMem)]+ga1 =+    [+    (lab1f,lab1f,lab1f),+    (lab1v,lab1v,lab1v),+    (lab2f,lab2f,lab2f),+    (lab2v,lab2v,lab2v),+    (lab1f,lab1f,lab1v),+    (lab1f,lab1f,lab2f),+    (lab1f,lab1f,lab2v),+    (lab1v,lab1v,lab1f),+    (lab1v,lab1v,lab2f),+    (lab1v,lab1v,lab2v),+    (lab1f,lab1v,lab2f),+    (lab1f,lab1v,lab2v),+    (lab1v,lab2f,lab2v)+    ]++gs4 :: Arc LabelMem -> Bool+gs4 (Arc _ _ (LV "lab2")) = True+gs4 (Arc _ _  _         ) = False++ga4 :: [(LabelMem, LabelMem, LabelMem)]+ga4 =+    [+    (lab2v,lab2v,lab2v),+    (lab1f,lab1f,lab2v),+    (lab1v,lab1v,lab2v),+    (lab1f,lab1v,lab2v),+    (lab1v,lab2f,lab2v)+    ]++gr2 :: GraphMem LabelMem+gr2 = GraphMem { arcs=[]::[Arc LabelMem] }++ga2 :: [(LabelMem, LabelMem, LabelMem)]+ga2 =+    [+    (lab1f,lab1f,lab1f),+    (lab1v,lab1v,lab1v),+    (lab2f,lab2f,lab2f),+    (lab2v,lab2v,lab2v)+    ]++gr3 :: GraphMem LabelMem+gr3 = GraphMem { arcs=[]::[Arc LabelMem] }++ga3 :: [(LabelMem, LabelMem, LabelMem)]+ga3 =+    [+    (lab1f,lab1f,lab1v),+    (lab1f,lab1f,lab2f),+    (lab1f,lab1f,lab2v),+    (lab1v,lab1v,lab1f),+    (lab1v,lab1v,lab2f),+    (lab1v,lab1v,lab2v),+    (lab1f,lab1v,lab2f),+    (lab1f,lab1v,lab2v),+    (lab1v,lab2f,lab2v)+    ]++gl4 :: [LabelMem]+gl4 = [lab1f,lab1v,lab2f,lab2v]++gr1a, gr2a, gr3a, gr4a, gr4b, gr4c, gr4d, gr4e,+  gr4g :: GraphMem LabelMem+gr1a = setArcsT ga1 gr1+gr2a = setArcsT ga2 gr2+gr3a = setArcsT ga3 gr3+gr4a = add gr2a gr3a+gr4b = add gr3a gr2a+gr4c = delete gr2a gr4a+gr4d = delete gr3a gr4a+gr4e = extract gs4 gr4a+gr4g = add gr2a gr4a++gl4f :: [LabelMem]+gl4f = labels gr4a++gr4ee :: [Bool]+gr4ee = map gs4 (getArcs gr4a)++testGraphSuite :: Test+testGraphSuite = TestList+    [ testeq "Graph01" ga1 (getArcsT gr1a)+    , testeq "Graph01" ga2 (getArcsT gr2a)+    , testeq "Graph03" ga3 (getArcsT gr3a)+    , testeqv "Graph04" ga1 (getArcsT gr4a)+    , testeqv "Graph05" ga1 (getArcsT gr4b)+    , testeqv "Graph06" ga3 (getArcsT gr4c)+    , testeqv "Graph07" ga2 (getArcsT gr4d)+    , testeqv "Graph08" ga4 (getArcsT gr4e)+    , testeqv "Graph09" gl4 gl4f+    , testeq "Graph10" ga1 (getArcsT gr4g)+    ]++------------------------------------------------------------+--+------------------------------------------------------------++------------------------------------------------------------+-- Define some common values+------------------------------------------------------------++s1, s2, s3, s4, s5, s6, s7, s8 :: LabelMem+s1 = LF "s1"+s2 = LF "s2"+s3 = LF "s3"+s4 = LF ""+s5 = LV "s5"+s6 = LF "basemore"+s7 = LF ("base"++"more")+s8 = LV "s8"++b1, b2, b3, b4 :: LabelMem+b1 = LV "b1"+b2 = LV "b2"+b3 = LV "b3"+b4 = LV "b4"++p1, p2, p3, p4 :: LabelMem+p1 = LF "p1"+p2 = LF "p2"+p3 = LF "p3"+p4 = LF "p4"++o1, o2, o3, o4, o5, o6 :: LabelMem+o1 = LF "o1"+o2 = LF "o2"+o3 = LF "o3"+o4 = LF ""+o5 = LV "o5"+o6 = LV "s5"++l1, l2, l3, l4, l5, l6, l7, l8, l9,+  l10, l11, l12 :: LabelMem+l1  = LF "l1"+l2  = LF "l2-en"+l3  = LF "l2-fr"+l4  = LF "l4-type1"+l5  = LF "l4-type1"+l6  = LF "l4-type1"+l7  = LF "l4-type2"+l8  = LF "l4-type2"+l9  = LF "l4-type2"+l10 = LF "l10-xml"+l11 = LF "l10-xml-en"+l12 = LF "l10-xml-fr"++v1, v2, v3, v4 :: LabelMem+v1  = LV "v1"+v2  = LV "v2"+v3  = LV "v3"+v4  = LV "v4"++------------------------------------------------------------+--  Label construction and equality tests+------------------------------------------------------------++testLabelEq :: String -> Bool -> LabelMem -> LabelMem -> Test+testLabelEq lab eq n1 n2 =+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )++nodelist :: [(String, LabelMem)]+nodelist =+  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5),+    ("s6",s6), ("s7",s7), ("s8",s8),+    ("o5",o5),+    ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4),+    ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4),+    ("l1",l1), ("l2",l2), ("l3",l3), ("l4",l4), ("l5",l5),+    ("l6",l6), ("l7",l7), ("l8",l8), ("l9",l9),+    ("l10",l10), ("l11",l11), ("l12",l12),+    ("v1",v1), ("v2",v2)+  ]++nodeeqlist :: [(String, String)]+nodeeqlist =+  [+    ("s4","o4"),+    ("s5","o6"),+    ("s6","s7"),+    ("l4","l5"),+    ("l4","l6"),+    ("l5","l6"),+    ("l7","l8"),+    ("l7","l9"),+    ("l8","l9")+  ]++testLabelEqSuite :: Test+testLabelEqSuite = TestList+  [ testLabelEq (testLab a b) (testEq  a b) n1 n2+      | (a,n1) <- nodelist , (b,n2) <- nodelist ]+    where+    testLab a b = a ++ "-" ++ b+    testEq  a b = (a == b)        ||+            (a,b) `elem` nodeeqlist ||+            (b,a) `elem` nodeeqlist+++------------------------------------------------------------+--  Label ordering tests+------------------------------------------------------------++testLabelOrd :: String -> Ordering -> LabelMem -> LabelMem -> Test+testLabelOrd lab order n1 n2 =+    TestCase ( assertEqual ("testLabelOrd:"++lab) order (compare n1 n2) )++nodeorder :: [String]+nodeorder =+  [+    "o4",+    "s4", "s6", "s7",+    "l1", "l10", "l11", "l12", "l2", "l3", "l4", "l5", "l6", "l7", "l8", "l9",+    "o1", "o2", "o3",+    "p1", "p2", "p3", "p4",+    "s1", "s2", "s3",+    "b1", "b2", "b3", "b4",+    "o5",+    "s5", "s8",+    "v1", "v2"+  ]++testLabelOrdSuite :: Test+testLabelOrdSuite = TestList+  [ testLabelOrd (testLab a b) (testOrd a b) n1 n2+      | (a,n1) <- nodelist , (b,n2) <- nodelist ]+    where+    testLab a b = a ++ "-" ++ b+    testOrd a b+      | testEq a b = EQ+      | otherwise  = compare (fromJust $ elemIndex a nodeorder)+                      (fromJust $ elemIndex b nodeorder)+    testEq  a b = (a == b)        ||+            (a,b) `elem` nodeeqlist ||+            (b,a) `elem` nodeeqlist+++------------------------------------------------------------+-- Statement construction and equality tests+------------------------------------------------------------++type Statement = Arc LabelMem++testStmtEq :: String -> Bool -> Statement -> Statement -> Test+testStmtEq lab eq t1 t2 =+    TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )++slist :: [(String, LabelMem)]+slist =+  [+    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)+  ]++plist :: [(String, LabelMem)]+plist =+  [+    ("p1",p1)+  ]++olist :: [(String, LabelMem)]+olist =+  [ ("o1",o1), ("o4",o4), ("o5",o5),+    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)+  ]++tlist :: [(String, Arc LabelMem)]+tlist =+  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]+    where+    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o+    trp (_,s) (_,p) (_,o) = Arc s p o++stmteqlist :: [(String, String)]+stmteqlist =+  [+    ("s6.p1.l1", "s7.p1.l1"),+    ("s6.p1.l4", "s7.p1.l4"),+    ("s6.p1.l7", "s7.p1.l7"),+    ("s6.p1.l7", "s7.p1.l8"),+    ("s6.p1.l8", "s7.p1.l7"),+    ("s6.p1.l8", "s7.p1.l8"),+    ("s6.p1.l10","s7.p1.l10"),+    ("s6.p1.o1", "s7.p1.o1"),+    ("s6.p1.o4", "s7.p1.o4"),+    ("s6.p1.o5", "s7.p1.o5"),+    ("s1.p1.l7", "s1.p1.l8"),+    ("s4.p1.l7", "s4.p1.l8"),+    ("s5.p1.l7", "s5.p1.l8"),+    ("s6.p1.l7", "s6.p1.l8"),+    ("s7.p1.l7", "s7.p1.l8")+  ]++testStmtEqSuite :: Test+testStmtEqSuite = TestList+  [ testStmtEq (testLab a b) (testEq  a b) t1 t2+      | (a,t1) <- tlist , (b,t2) <- tlist ]+    where+    testLab a b = a ++ "-" ++ b+    testEq  a b = (a == b)        ||+            (a,b) `elem` stmteqlist ||+            (b,a) `elem` stmteqlist++------------------------------------------------------------+--  Graph element handling support routines+------------------------------------------------------------++lmap :: LabelMap LabelMem+lmap = tstLabelMap 5 [(s1,(1,1)),(s2,(2,2)),(s3,(3,3)),(s4,(4,4)),+                      (o1,(1,1)),(o2,(2,2)),(o3,(3,3))]+       +-- setLabelHash :: (Label lb) => LabelMap lb -> (lb,Int) -> LabelMap lb+lmap1, lmap2a, lmap2b, lmap3 :: LabelMap LabelMem+lmap1  = setLabelHash lmap (s2,22)+lmap2a = setLabelHash lmap1  (o1,66)+lmap2b = setLabelHash lmap2a (o5,67)++-- newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb+lmap3 = newLabelMap lmap [(s1,61),(s3,63),(o2,66)]++llst :: [String]       +llst = ["s1","s2","s3","s4","o1","o2","o3"]++-- showLabelMap :: (Label lb) => LabelMap lb -> String++testShowLabelMap :: Test+testShowLabelMap = testeq "showLabelMap" showMap (show lmap)+    where+        showMap = "LabelMap gen=5, map=\n"+++                  "    !s1:(1,1)\n"+++                  "    !s2:(2,2)\n"+++                  "    !s3:(3,3)\n"+++                  "    !:(4,4)\n"+++                  "    !o1:(1,1)\n"+++                  "    !o2:(2,2)\n"+++                  "    !o3:(3,3)"++testMapLabelHash00 :: Test+testMapLabelHash00 = testeq "mapLabelHash00" showMap (show lmap1)+    where+        showMap = "LabelMap gen=5, map=\n"+++                  "    !s1:(1,1)\n"+++                  "    !s2:(5,22)\n"+++                  "    !s3:(3,3)\n"+++                  "    !:(4,4)\n"+++                  "    !o1:(1,1)\n"+++                  "    !o2:(2,2)\n"+++                  "    !o3:(3,3)"++-- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex++testLabelMapSuite :: Test+testLabelMapSuite = TestList+  [ testShowLabelMap+  , testMapLabelHash00++  , testeq "testMapLabelIndex01" (1,1) (mapLabelIndex lmap s1 )+  , testeq "testMapLabelIndex02" (2,2) (mapLabelIndex lmap s2 )+  , testeq "testMapLabelIndex03" (3,3) (mapLabelIndex lmap s3 )+  , testeq "testMapLabelIndex04" (4,4) (mapLabelIndex lmap s4 )+  , testeq "testMapLabelIndex05" (1,1) (mapLabelIndex lmap o1 )+  , testeq "testMapLabelIndex06" (4,4) (mapLabelIndex lmap o4 )+  , testeq "testMapLabelIndex07" nullLabelVal (mapLabelIndex lmap o5 )+  , testeq "testMapLabelIndex08" nullLabelVal (mapLabelIndex lmap o6 )++  , testeq "MapLabelHash01" (1,1)  (mapLabelIndex lmap1 s1 )+  , testeq "MapLabelHash02" (5,22) (mapLabelIndex lmap1 s2 )+  , testeq "MapLabelHash03" (3,3)  (mapLabelIndex lmap1 s3 )+  , testeq "MapLabelHash04" (4,4)  (mapLabelIndex lmap1 s4 )+  , testeq "MapLabelHash05" (1,1)  (mapLabelIndex lmap1 o1 )+  , testeq "MapLabelHash06" (4,4)  (mapLabelIndex lmap1 o4 )+  , testeq "MapLabelHash07" nullLabelVal (mapLabelIndex lmap1 o5 )+  , testeq "MapLabelHash08" nullLabelVal (mapLabelIndex lmap1 o6 )++  , testeq "MapLabelHash11" (1,1)  (mapLabelIndex lmap2b s1 )+  , testeq "MapLabelHash12" (5,22) (mapLabelIndex lmap2b s2 )+  , testeq "MapLabelHash13" (3,3)  (mapLabelIndex lmap2b s3 )+  , testeq "MapLabelHash14" (4,4)  (mapLabelIndex lmap2b s4 )+  , testeq "MapLabelHash15" (5,66) (mapLabelIndex lmap2b o1 )+  , testeq "MapLabelHash16" (2,2)  (mapLabelIndex lmap2b o2 )+  , testeq "MapLabelHash17" (4,4)  (mapLabelIndex lmap2b o4 )+  , testeq "MapLabelHash18" nullLabelVal (mapLabelIndex lmap1 o5 )+    +  , testeq "LabelMap01" (6,61) (mapLabelIndex lmap3 s1 )+  , testeq "LabelMap02" (2,2)  (mapLabelIndex lmap3 s2 )+  , testeq "LabelMap03" (6,63) (mapLabelIndex lmap3 s3 )+  , testeq "LabelMap04" (4,4)  (mapLabelIndex lmap3 s4 )+  , testeq "LabelMap05" (1,1)  (mapLabelIndex lmap3 o1 )+  , testeq "LabelMap06" (6,66) (mapLabelIndex lmap3 o2 )+    +  ]++------------------------------------------------------------+--  Graph matching support+------------------------------------------------------------++t01, t02, t03, t04, t05, t06 :: Arc LabelMem+t01 = toStatement s1 p1 o1+t02 = toStatement s2 p1 o2+t03 = toStatement s3 p1 o3+t04 = toStatement s1 p1 l1+t05 = toStatement s2 p1 l4+t06 = toStatement s3 p1 l10++t10, t11, t12 :: Arc LabelMem+t10 = toStatement s1 p1 b1+t11 = toStatement b1 p2 b2+t12 = toStatement b2 p3 o1++t20, t21, t22 :: Arc LabelMem+t20 = toStatement s1 p1 b3+t21 = toStatement b3 p2 b4+t22 = toStatement b4 p3 o1++as1, as2, as4, as5, as6 :: [Arc LabelMem]+as1 = [t01]+as2 = [t01,t02,t03,t04,t05,t06]+as4 = [t01,t02,t03,t04,t05,t06,t10,t11,t12]+as5 = [t01,t02,t03,t04,t05,t06,t20,t21,t22]+as6 = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]++-- graphLabels :: (Label lb) => [Arc lb] -> [lb]++ls4 :: [LabelMem]+ls4 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]++testGraphLabels04, testGraphLabels14 :: Test+testGraphLabels04 = testeqv "GraphLabels04" ls4 (graphLabels as4)+testGraphLabels14 = testeq  "GraphLabels14" str (show (graphLabels as4))+    where+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]"+        -- str = "[!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"++ls5 :: [LabelMem]+ls5 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]++testGraphLabels05, testGraphLabels15 :: Test+testGraphLabels05 = testeqv "GraphLabels05" ls5 (graphLabels as5)+testGraphLabels15 = testeq  "GraphLabels15" str (show (graphLabels as5))+    where+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]"+        -- str = "[!p3,?b4,!p2,?b3,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"++ls6 :: [LabelMem]+ls6 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]++testGraphLabels06, testGraphLabels16 :: Test+testGraphLabels06 = testeqv "GraphLabels05" ls6 (graphLabels as6)+testGraphLabels16 = testeq  "GraphLabels16" str (show (graphLabels as6))+    where+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"+++              ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]"+        -- str = "[?b4,?b3,!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1"+++        --       ",!o3,!s3,!o2,!s2,!o1,!p1,!s1]"++-- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb++lmap5 :: LabelMap LabelMem+lmap5 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),+                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),+                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),+                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),+                       (b3,(1,262143)),(b4,(1,262143))]+        +testAssignLabelMap05 :: Test        +testAssignLabelMap05 = testeq "AssignLabels05" lmap5+                        (newGenerationMap $ assignLabelMap ls5 emptyMap)++lmap6 :: LabelMap LabelMem+lmap6 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),+                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),+                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),+                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),+                       (b1,(2,262143)),(b2,(2,262143)),(b3,(1,262143)),(b4,(1,262143))]++testAssignLabelMap06 :: Test+testAssignLabelMap06 = testeq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)++lmapc :: LabelMap LabelMem+lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)),+                       (p1,(1,21)),(p2,(1,22)),(p3,(1,13)),+                       (o1,(1,31)),(o2,(1,32)),(o3,(1,13)),+                       (l1,(1,41)),(l4,(1,42)),(l10,(1,43)),+                       (b1,(1,51)),(b2,(1,51)),(b3,(1,51)),(b4,(1,51))]++-- [[[TODO: test hash value collision on non-variable label]]]++testGraphMatchSupportSuite :: Test+testGraphMatchSupportSuite = TestList+  [ testGraphLabels04+  , testGraphLabels14+  , testGraphLabels05+  , testGraphLabels15+  , testGraphLabels06+  , testGraphLabels16+  , testAssignLabelMap05+  , testAssignLabelMap06+  ]++------------------------------------------------------------+--  Test steps in graph equality test+------------------------------------------------------------++matchable :: a -> b -> Bool+matchable _ _ = True++s1_1, s2_1, s3_1 :: ScopedLabel LabelMem+s1_1 = makeScopedLabel 1 s1+s2_1 = makeScopedLabel 1 s2+s3_1 = makeScopedLabel 1 s3++p1_1, p2_1, p3_1 :: ScopedLabel LabelMem+p1_1 = makeScopedLabel 1 p1+p2_1 = makeScopedLabel 1 p2+p3_1 = makeScopedLabel 1 p3++o1_1, o2_1, o3_1 :: ScopedLabel LabelMem+o1_1 = makeScopedLabel 1 o1+o2_1 = makeScopedLabel 1 o2+o3_1 = makeScopedLabel 1 o3++l1_1, l4_1, l10_1 :: ScopedLabel LabelMem+l1_1 = makeScopedLabel 1 l1+l4_1 = makeScopedLabel 1 l4+l10_1 = makeScopedLabel 1 l10++b1_1, b2_1, b3_1, b4_1 :: ScopedLabel LabelMem+b1_1 = makeScopedLabel 1 b1+b2_1 = makeScopedLabel 1 b2+b3_1 = makeScopedLabel 1 b3+b4_1 = makeScopedLabel 1 b4++s1_2, s2_2, s3_2 :: ScopedLabel LabelMem+s1_2 = makeScopedLabel 2 s1+s2_2 = makeScopedLabel 2 s2+s3_2 = makeScopedLabel 2 s3++p1_2, p2_2, p3_2 :: ScopedLabel LabelMem+p1_2 = makeScopedLabel 2 p1+p2_2 = makeScopedLabel 2 p2+p3_2 = makeScopedLabel 2 p3++o1_2, o2_2, o3_2 :: ScopedLabel LabelMem+o1_2 = makeScopedLabel 2 o1+o2_2 = makeScopedLabel 2 o2+o3_2 = makeScopedLabel 2 o3++l1_2, l4_2, l10_2 :: ScopedLabel LabelMem+l1_2 = makeScopedLabel 2 l1+l4_2 = makeScopedLabel 2 l4+l10_2 = makeScopedLabel 2 l10++b1_2, b2_2, b3_2, b4_2 :: ScopedLabel LabelMem+b1_2 = makeScopedLabel 2 b1+b2_2 = makeScopedLabel 2 b2+b3_2 = makeScopedLabel 2 b3+b4_2 = makeScopedLabel 2 b4++t01_1 :: Arc (ScopedLabel LabelMem)+t01_1 = makeScopedArc 1 t01++t01_2, t02_2, t03_2, t04_2, t05_2, t06_2 :: Arc (ScopedLabel LabelMem)+t01_2 = makeScopedArc 2 t01+t02_2 = makeScopedArc 2 t02+t03_2 = makeScopedArc 2 t03+t04_2 = makeScopedArc 2 t04+t05_2 = makeScopedArc 2 t05+t06_2 = makeScopedArc 2 t06++t10_1, t11_1, t12_1, t20_1, t21_1, t22_1 :: Arc (ScopedLabel LabelMem)+t10_1 = makeScopedArc 1 t10+t11_1 = makeScopedArc 1 t11+t12_1 = makeScopedArc 1 t12+t20_1 = makeScopedArc 1 t20+t21_1 = makeScopedArc 1 t21+t22_1 = makeScopedArc 1 t22++t10_2, t11_2, t12_2, t20_2, t21_2, t22_2 :: Arc (ScopedLabel LabelMem)+t10_2 = makeScopedArc 2 t10+t11_2 = makeScopedArc 2 t11+t12_2 = makeScopedArc 2 t12+t20_2 = makeScopedArc 2 t20+t21_2 = makeScopedArc 2 t21+t22_2 = makeScopedArc 2 t22++-- Compare graph as6 with self, in steps++as61, as62 :: [Arc (ScopedLabel LabelMem)]+as61 = map (makeScopedArc 1) as6+as62 = map (makeScopedArc 2) as6++eq1lmap :: LabelMap (ScopedLabel LabelMem)+eq1lmap     = newGenerationMap $+              assignLabelMap (graphLabels as62) $+              assignLabelMap (graphLabels as61) emptyMap++eq1ltst :: LabelMap (ScopedLabel LabelMem)+eq1ltst     = tstLabelMap 2 [+                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                             (b1_1,(1,262143)),(b2_1,(1,262143)),(b3_1,(1,262143)),(b4_1,(1,262143)),+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                             (b1_2,(1,262143)),(b2_2,(1,262143)),(b3_2,(1,262143)),(b4_2,(1,262143))+                            ]+              +testEqAssignMap01 :: Test              +testEqAssignMap01 = testeq "EqAssignMap01" eq1ltst eq1lmap++eq1hs1, eq1hs2 :: [Arc (ScopedLabel LabelMem)]+eq1hs1      = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1]+eq1hs2      = [t10_2,t11_2,t12_2,t20_2,t21_2,t22_2]++eq1lmap' :: LabelMap (ScopedLabel LabelMem)+eq1lmap'    = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),+                                                (b3_1,(2,3880463)),+                                                (b4_1,(2,3400925)),+                             (b1_2,(2,3880463)),(b2_2,(2,3400925)),+                                                (b3_2,(2,3880463)),+                                                (b4_2,(2,3400925))]++eq1lmap'' :: LabelMap (ScopedLabel LabelMem)+eq1lmap''   = newLabelMap eq1lmap'+                [+                (b1_1,2576315),(b2_1,3400925),(b3_1,1571691),+                (b1_2,2576315),(b2_2,3400925),(b3_2,1571691)+                ]++eq1ltst'' :: LabelMap (ScopedLabel LabelMem)+eq1ltst''   = tstLabelMap 3 [+                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                            (b1_1,(3,2576315)),+                            (b2_1,(3,3400925)),+                            (b3_1,(3,1571691)),+                            (b4_1,(2,3400925)),+                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                            (b1_2,(3,2576315)),+                            (b2_2,(3,3400925)),+                            (b3_2,(3,1571691)),+                            (b4_2,(2,3400925))+                            ]++testEqNewLabelMap07 :: Test+testEqNewLabelMap07 = testeq "EqNewLabelMap07" eq1ltst'' eq1lmap''++-- Repeat same tests for as4...++as41, as42 :: [Arc (ScopedLabel LabelMem)]+as41 = map (makeScopedArc 1) as4+as42 = map (makeScopedArc 2) as4++eq2lmap :: LabelMap (ScopedLabel LabelMem)+eq2lmap     = newGenerationMap $+              assignLabelMap (graphLabels as42) $+              assignLabelMap (graphLabels as41) emptyMap+              +eq2ltst :: LabelMap (ScopedLabel LabelMem)+eq2ltst     = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                             (b1_1,(1,262143)),(b2_1,(1,262143)),+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                             (b1_2,(1,262143)),(b2_2,(1,262143))]+              +testEqAssignMap21 :: Test+testEqAssignMap21 = testeq "EqAssignMap21" eq2ltst eq2lmap++eq2hs1, eq2hs2 :: [Arc (ScopedLabel LabelMem)]+eq2hs1      = [t10_1,t11_1,t12_1]+eq2hs2      = [t10_2,t11_2,t12_2]++eq2lmap' :: LabelMap (ScopedLabel LabelMem)+eq2lmap'    = tstLabelMap 2 [+                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                             (b1_2,(2,3880463)),(b2_2,(2,3400925))+                            ]++eq2lmap'' :: LabelMap (ScopedLabel LabelMem)+eq2lmap''   = newLabelMap eq2lmap'+                [+                (b2_1,3400925),+                (b2_2,3400925)+                ]+                +eq2ltst'' :: LabelMap (ScopedLabel LabelMem)+eq2ltst''   = tstLabelMap 3 [+                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),+                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),+                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),+                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),+                            (b1_1,(2,3880463)),+                            (b2_1,(3,3400925)),+                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),+                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),+                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),+                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),+                            (b1_2,(2,3880463)),+                            (b2_2,(3,3400925))+                            ]++testEqNewLabelMap27 :: Test+testEqNewLabelMap27 = testeq "EqNewLabelMap27" eq2ltst'' eq2lmap''++-- Compare as1 with as2, in steps++as11, as22 :: [Arc (ScopedLabel LabelMem)]+as11 = map (makeScopedArc 1) as1+as22 = map (makeScopedArc 2) as2++eq3hs1, eq3hs2 :: [Arc (ScopedLabel LabelMem)]+eq3hs1   = [t01_1]+eq3hs2   = [t01_2,t02_2,t03_2,t04_2,t05_2,t06_2]++testEqGraphMap31_1, testEqGraphMap31_2 :: Test+testEqGraphMap31_1 = testeq "testEqGraphMap31_1" eq3hs1 as11+testEqGraphMap31_2 = testeq "testEqGraphMap31_2" eq3hs2 as22++eq3lmap :: LabelMap (ScopedLabel LabelMem)+eq3lmap     = newGenerationMap $+              assignLabelMap (graphLabels as11) $+              assignLabelMap (graphLabels as22) emptyMap+              +eq3ltst :: LabelMap (ScopedLabel LabelMem)+eq3ltst     = tstLabelMap 2+    [ (s1_1,(1,142577))+    , (p1_1,(1,142385))+    , (o1_1,(1,142321))+    , (s1_2,(1,142577)), (s2_2,(1,142578)), (s3_2,(1,142579))+    , (p1_2,(1,142385))+    , (o1_2,(1,142321)), (o2_2,(1,142322)), (o3_2,(1,142323))+    , (l1_2,(1,142129)), (l4_2,(1,1709580)), (l10_2,(1,3766582))+    ]+    +testEqAssignMap32 :: Test    +testEqAssignMap32 = testeq "EqAssignMap32" eq3ltst eq3lmap++type EquivClass = EquivalenceClass (ScopedLabel LabelMem)+type EquivArgs  = ((Int, Int), [ScopedLabel LabelMem])++ec31 :: [EquivClass]+ec31     = equivalenceClasses eq3lmap (graphLabels as11)++ec31test :: [EquivArgs]+ec31test =+    [ ((1,142321),[o1_1])+    , ((1,142385),[p1_1])+    , ((1,142577),[s1_1])+    ]++ec32 :: [EquivClass]+ec32 = equivalenceClasses eq3lmap (graphLabels as22)++ec32test :: [EquivArgs]+ec32test =+    [ ((1,142129),[l1_2])+    , ((1,142321),[o1_2])+    , ((1,142322),[o2_2])+    , ((1,142323),[o3_2])+    , ((1,142385),[p1_2])+    , ((1,142577),[s1_2])+    , ((1,142578),[s2_2])+    , ((1,142579),[s3_2])+    , ((1,1709580),[l4_2])+    , ((1,3766582),[l10_2])+    ]++testEquivClass33_1, testEquivClass33_2 :: Test+testEquivClass33_1 = testeq "EquivClass33_1" ec31test ec31+testEquivClass33_2 = testeq "EquivClass33_2" ec32test ec32++-- This value is nonsense for this test,+-- but a parameter is needed for graphMatch1 (below)++ec3pairs :: [(EquivClass, EquivClass)]+ec3pairs = zip (pairSort ec31) (pairSort ec32)++ec3test :: [(EquivClass, EquivClass)]+ec3test  =+    [ ( ((1,142321),[o1_1]), ((1,142321),[o1_2]) )+    , ( ((1,142385),[p1_1]), ((1,142385),[p1_2]) )+    , ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) )+    ]++{-  This is a pointless test in this case+testEquivClass33_3 = testeq "EquivClass33_3" ec3test ec3pairs+-}++eq3lmap1 :: (Bool, LabelMap (ScopedLabel LabelMem))+eq3lmap1 = graphMatch1 False matchable eq3hs1 eq3hs2 eq3lmap ec3pairs++eq3ltst1 :: LabelMap (ScopedLabel LabelMem)+eq3ltst1 = tstLabelMap 2+    [ (o1_1,(1,142321))+    , (p1_1,(1,142385))+    , (s1_1,(1,142577))+    , (l10_2,(1,3766582))+    , (l4_2,(1,1709580))+    , (l1_2,(1,142129))+    , (o3_2,(1,142323))+    , (s3_2,(1,142579))+    , (o2_2,(1,142322))+    , (s2_2,(1,142578))+    , (o1_2,(1,142321))+    , (p1_2,(1,142385))+    , (s1_2,(1,142577))+    ]+-- testEqAssignMap34 = testeq "EqAssignMap34" (Just eq3ltst1) eq3lmap1+-- testEqAssignMap34 = testeq "EqAssignMap34" Nothing eq3lmap1++testEqAssignMap34 :: Test+testEqAssignMap34 = testeq "EqAssignMap34" False (fst eq3lmap1)++{-+eq3rc1      = reclassify eq3hs1 eq3lmap+eq3rctst1   = []+testEqReclassify35_1 = testeqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1+eq3rc2      = reclassify eq3hs2 eq3lmap+eq3rctst2   = []+testEqReclassify35_2 = testeqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2+-}+++-- Test suite++testGraphMatchStepSuite :: Test+testGraphMatchStepSuite = TestList+  [ testEqAssignMap01+  -- , testEqReclassify03_1, testEqReclassify03_2+  , testEqNewLabelMap07+  -- , testEqGraphMatch08+  , testEqAssignMap21+  -- , testEqReclassify23_1, testEqReclassify23_2+  , testEqNewLabelMap27+  -- , testEqGraphMatch28+  , testEqGraphMap31_1, testEqGraphMap31_2+  , testEqAssignMap32+  , testEquivClass33_1, testEquivClass33_2 -- , testEquivClass33_3+  , testEqAssignMap34+  -- , testEqReclassify35_1, testEqReclassify35_2+  ]++------------------------------------------------------------+--  Graph equality tests+------------------------------------------------------------++testGraphEq :: ( Label lb ) => String -> Bool -> GraphMem lb -> GraphMem lb -> Test+testGraphEq lab eq gg1 gg2 =+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )++g1, g2, g3, g4, g5, g6, g7, g8 :: GraphMem LabelMem+g1 = GraphMem { arcs = [t01] }+g2 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06] }+g3 = GraphMem { arcs = [t06,t05,t04,t03,t02,t01] }+g4 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12] }+g5 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t20,t21,t22] }+g6 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] }+g7 = GraphMem { arcs = [t01,t02] }+g8 = GraphMem { arcs = [t02,t01] }++glist :: [(String, GraphMem LabelMem)]+glist =+  [ ("g1",g1), ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6) ]++grapheqlist :: [(String, String)]+grapheqlist =+  [ ("g2","g3")+  , ("g4","g5")+  ]++testGraphEqSuitePart :: Test+testGraphEqSuitePart = TestLabel "testGraphEqSuitePart" $ TestList+  [ testGraphEq "g1-g2" False g1 g2+  , testGraphEq "g2-g1" False g2 g1+  , testGraphEq "g2-g2" True  g2 g2+  , testGraphEq "g2-g3" True  g2 g3+  , testGraphEq "g1-g4" False g1 g4+  , testGraphEq "g2-g4" False g2 g4+  , testGraphEq "g3-g4" False g3 g4+  , testGraphEq "g4-g3" False g4 g3+  , testGraphEq "g4-g4" True  g4 g4+  , testGraphEq "g4-g5" True  g4 g5+  , testGraphEq "g4-g6" False g4 g6+  , testGraphEq "g6-g6" True  g6 g6+  , testGraphEq "g7-g7" True  g7 g7+  , testGraphEq "g7-g8" True  g7 g8+  , testGraphEq "g8-g7" True  g8 g7+  ]++testGraphEqSuite :: Test+testGraphEqSuite = TestLabel "testGraphEqSuite" $ TestList+  [ testGraphEq (testLab ll1 ll2) (testEq ll1 ll2) gg1 gg2+      | (ll1,gg1) <- glist , (ll2,gg2) <- glist ]+    where+    testLab ll1 ll2 = ll1 ++ "-" ++ ll2+    testEq  ll1 ll2 = (ll1 == ll2)        ||+            (ll1,ll2) `elem` grapheqlist ||+            (ll2,ll1) `elem` grapheqlist++-- Selected tests for debugging++geq12, geq21, geq22, geq23, geq14, geq24, geq77, geq78, geq87 :: Test+geq12 = testGraphEq "g1-g2" False g1 g2+geq21 = testGraphEq "g2-g1" False g2 g1+geq22 = testGraphEq "g2-g2" True  g2 g2+geq23 = testGraphEq "g2-g3" True  g2 g3+geq14 = testGraphEq "g1-g4" False g1 g4+geq24 = testGraphEq "g2-g4" False g2 g4+geq77 = testGraphEq "g7-g7" True  g7 g7+geq78 = testGraphEq "g7-g8" True  g7 g8+geq87 = testGraphEq "g8-g7" True  g8 g7+++------------------------------------------------------------+--  More graph equality tests+------------------------------------------------------------+--+--  These tests are based on the 10-node, triply connected+--  graph examples in Jeremy Carroll's paper on matching RDF+--  graphs.++--  Graph pattern 1:+--  pentangle-in-pentangle, corresponding vertices linked upward++v101, v102, v103, v104, v105, v106, v107, v108,+  v109, v110 :: LabelMem+v101  = LV "v101"+v102  = LV "v102"+v103  = LV "v103"+v104  = LV "v104"+v105  = LV "v105"+v106  = LV "v106"+v107  = LV "v107"+v108  = LV "v108"+v109  = LV "v109"+v110  = LV "v110"++p101, p102, p103, p104, p105, p106, p107, p108,+  p109, p110, p111, p112, p113, p114, p115 :: LabelMem+p101  = LV "p101"+p102  = LV "p102"+p103  = LV "p103"+p104  = LV "p104"+p105  = LV "p105"+p106  = LV "p106"+p107  = LV "p107"+p108  = LV "p108"+p109  = LV "p109"+p110  = LV "p110"+p111  = LV "p111"+p112  = LV "p112"+p113  = LV "p113"+p114  = LV "p114"+p115  = LV "p115"++t10102, t10203, t10304, t10405, t10501, t10106,+  t10207, t10308, t10409, t10510, t10607,+  t10708, t10809, t10910, t11006 :: Arc LabelMem+t10102 = toStatement v101 p101 v102+t10203 = toStatement v102 p102 v103+t10304 = toStatement v103 p103 v104+t10405 = toStatement v104 p104 v105+t10501 = toStatement v105 p105 v101+t10106 = toStatement v101 p106 v106+t10207 = toStatement v102 p107 v107+t10308 = toStatement v103 p108 v108+t10409 = toStatement v104 p109 v109+t10510 = toStatement v105 p110 v110+t10607 = toStatement v106 p111 v107+t10708 = toStatement v107 p112 v108+t10809 = toStatement v108 p113 v109+t10910 = toStatement v109 p114 v110+t11006 = toStatement v110 p115 v106++--  Graph pattern 2:+--  pentangle-in-pentangle, corresponding vertices linked downward++v201, v202, v203, v204, v205, v206, v207, v208,+  v209, v210 :: LabelMem+v201  = LV "v201"+v202  = LV "v202"+v203  = LV "v203"+v204  = LV "v204"+v205  = LV "v205"+v206  = LV "v206"+v207  = LV "v207"+v208  = LV "v208"+v209  = LV "v209"+v210  = LV "v210"++p201, p202, p203, p204, p205, p206, p207, p208,+  p209, p210, p211, p212, p213, p214, p215 :: LabelMem+p201  = LV "p201"+p202  = LV "p202"+p203  = LV "p203"+p204  = LV "p204"+p205  = LV "p205"+p206  = LV "p206"+p207  = LV "p207"+p208  = LV "p208"+p209  = LV "p209"+p210  = LV "p210"+p211  = LV "p211"+p212  = LV "p212"+p213  = LV "p213"+p214  = LV "p214"+p215  = LV "p215"++t20102, t20203, t20304, t20405, t20501, t20601,+  t20702, t20803, t20904, t21005, t20607,+  t20708, t20809, t20910, t21006 :: Arc LabelMem+t20102 = toStatement v201 p201 v202+t20203 = toStatement v202 p202 v203+t20304 = toStatement v203 p203 v204+t20405 = toStatement v204 p204 v205+t20501 = toStatement v205 p205 v201+t20601 = toStatement v206 p206 v201+t20702 = toStatement v207 p207 v202+t20803 = toStatement v208 p208 v203+t20904 = toStatement v209 p209 v204+t21005 = toStatement v210 p210 v205+t20607 = toStatement v206 p211 v207+t20708 = toStatement v207 p212 v208+t20809 = toStatement v208 p213 v209+t20910 = toStatement v209 p214 v210+t21006 = toStatement v210 p215 v206++--  Graph pattern 3:+--  star-in-pentangle, corresponding vertices linked toward star+--  Although this graph is similarly linked to patterns 1 and 2,+--  it is topologically different as it contains circuits only of+--  length 5, where the others have circuits of length 4 and 5+--  (ignoring direction of arcs)++v301, v302, v303, v304, v305, v306, v307, v308,+  v309, v310 :: LabelMem+v301  = LV "v301"+v302  = LV "v302"+v303  = LV "v303"+v304  = LV "v304"+v305  = LV "v305"+v306  = LV "v306"+v307  = LV "v307"+v308  = LV "v308"+v309  = LV "v309"+v310  = LV "v310"++p301, p302, p303, p304, p305, p306, p307, p308,+  p309, p310, p311, p312, p313, p314, p315 :: LabelMem+p301  = LV "p301"+p302  = LV "p302"+p303  = LV "p303"+p304  = LV "p304"+p305  = LV "p305"+p306  = LV "p306"+p307  = LV "p307"+p308  = LV "p308"+p309  = LV "p309"+p310  = LV "p310"+p311  = LV "p311"+p312  = LV "p312"+p313  = LV "p313"+p314  = LV "p314"+p315  = LV "p315"++t30102, t30203, t30304, t30405, t30501, t30106,+  t30207, t30308, t30409, t30510, t30608,+  t30709, t30810, t30906, t31007 :: Arc LabelMem+t30102 = toStatement v301 p301 v302+t30203 = toStatement v302 p302 v303+t30304 = toStatement v303 p303 v304+t30405 = toStatement v304 p304 v305+t30501 = toStatement v305 p305 v301+t30106 = toStatement v301 p306 v306+t30207 = toStatement v302 p307 v307+t30308 = toStatement v303 p308 v308+t30409 = toStatement v304 p309 v309+t30510 = toStatement v305 p310 v310+t30608 = toStatement v306 p311 v308+t30709 = toStatement v307 p312 v309+t30810 = toStatement v308 p313 v310+t30906 = toStatement v309 p314 v306+t31007 = toStatement v310 p315 v307++--  Graph pattern 4:+--  pentangle-in-pentangle, corresponding vertices linked upward+--  The vertices 6-10 are linked in reverse order to the+--  corresponding vertices 1-5.++v401, v402, v403, v404, v405, v406, v407, v408,+  v409, v410 :: LabelMem+v401  = LV "v401"+v402  = LV "v402"+v403  = LV "v403"+v404  = LV "v404"+v405  = LV "v405"+v406  = LV "v406"+v407  = LV "v407"+v408  = LV "v408"+v409  = LV "v409"+v410  = LV "v410"++p401, p402, p403, p404, p405, p406, p407, p408,+  p409, p410, p411, p412, p413, p414, p415 :: LabelMem+p401  = LV "p401"+p402  = LV "p402"+p403  = LV "p403"+p404  = LV "p404"+p405  = LV "p405"+p406  = LV "p406"+p407  = LV "p407"+p408  = LV "p408"+p409  = LV "p409"+p410  = LV "p410"+p411  = LV "p411"+p412  = LV "p412"+p413  = LV "p413"+p414  = LV "p414"+p415  = LV "p415"++t40102, t40203, t40304, t40405, t40501, t40106,+  t40207, t40308, t40409, t40510, t41009,+  t40908, t40807, t40706, t40610:: Arc LabelMem+t40102 = toStatement v401 p401 v402+t40203 = toStatement v402 p402 v403+t40304 = toStatement v403 p403 v404+t40405 = toStatement v404 p404 v405+t40501 = toStatement v405 p405 v401+t40106 = toStatement v401 p406 v406+t40207 = toStatement v402 p407 v407+t40308 = toStatement v403 p408 v408+t40409 = toStatement v404 p409 v409+t40510 = toStatement v405 p410 v410+t41009 = toStatement v410 p411 v409+t40908 = toStatement v409 p412 v408+t40807 = toStatement v408 p413 v407+t40706 = toStatement v407 p414 v406+t40610 = toStatement v406 p415 v410++--  Graph pattern 5:+--  Same as pattern 1, except same fixed property in all cases.++p5 :: LabelMem+p5    = LF "p5"++t50102, t50203, t50304, t50405, t50501, t50106, t50207,+  t50308, t50409, t50510, t50607, t50708, t50809,+  t50910, t51006 :: Arc LabelMem+t50102 = toStatement v101 p5 v102+t50203 = toStatement v102 p5 v103+t50304 = toStatement v103 p5 v104+t50405 = toStatement v104 p5 v105+t50501 = toStatement v105 p5 v101+t50106 = toStatement v101 p5 v106+t50207 = toStatement v102 p5 v107+t50308 = toStatement v103 p5 v108+t50409 = toStatement v104 p5 v109+t50510 = toStatement v105 p5 v110+t50607 = toStatement v106 p5 v107+t50708 = toStatement v107 p5 v108+t50809 = toStatement v108 p5 v109+t50910 = toStatement v109 p5 v110+t51006 = toStatement v110 p5 v106++--  Graph pattern 6:+--  Same as pattern 5, with different variables++t60102, t60203, t60304, t60405, t60501, t60106,+  t60207, t60308, t60409, t60510, t60607, t60708,+  t60809, t60910, t61006 :: Arc LabelMem+t60102 = toStatement v201 p5 v202+t60203 = toStatement v202 p5 v203+t60304 = toStatement v203 p5 v204+t60405 = toStatement v204 p5 v205+t60501 = toStatement v205 p5 v201+t60106 = toStatement v201 p5 v206+t60207 = toStatement v202 p5 v207+t60308 = toStatement v203 p5 v208+t60409 = toStatement v204 p5 v209+t60510 = toStatement v205 p5 v210+t60607 = toStatement v206 p5 v207+t60708 = toStatement v207 p5 v208+t60809 = toStatement v208 p5 v209+t60910 = toStatement v209 p5 v210+t61006 = toStatement v210 p5 v206++--++arcsToGraph :: [Arc a] -> GraphMem a+arcsToGraph as = GraphMem { arcs = as }++-- Very simple case++g100 :: GraphMem LabelMem+g100 = arcsToGraph+       [ t10102, t10203, t10304, t10405, t10501,+         t10607, t10708, t10809, t10910, t11006+       ]++g200 :: GraphMem LabelMem+g200 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20607, t20708, t20809, t20910, t21006+       ]++-- 10/3 node graph comparisons++g101 :: GraphMem LabelMem+g101 = arcsToGraph+       [ t10102, t10203, t10304, t10405, t10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g201 :: GraphMem LabelMem+g201 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803, t20904, t21005,+         t20607, t20708, t20809, t20910, t21006 ]++g301 :: GraphMem LabelMem+g301 = arcsToGraph+       [ t30102, t30203, t30304, t30405, t30501,+         t30106, t30207, t30308, t30409, t30510,+         t30608, t30709, t30810, t30906, t31007 ]++g401 :: GraphMem LabelMem+g401 = arcsToGraph+       [ t40102, t40203, t40304, t40405, t40501,+         t40106, t40207, t40308, t40409, t40510,+         t40610, t40706, t40807, t40908, t41009 ]++g501 :: GraphMem LabelMem+g501 = arcsToGraph+       [ t50102, t50203, t50304, t50405, t50501,+         t50106, t50207, t50308, t50409, t50510,+         t50607, t50708, t50809, t50910, t51006 ]++g601 :: GraphMem LabelMem+g601 = arcsToGraph+       [ t60102, t60203, t60304, t60405, t60501,+         t60106, t60207, t60308, t60409, t60510,+         t60607, t60708, t60809, t60910, t61006 ]++-- Remove one arc from each++g102 :: GraphMem LabelMem+g102 = arcsToGraph+       [ t10102, t10203, t10304, t10405,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g202 :: GraphMem LabelMem+g202 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803, t20904, t21005,+                 t20708, t20809, t20910, t21006 ]++g302 :: GraphMem LabelMem+g302 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803, t20904,+         t20607, t20708, t20809, t20910, t21006 ]++-- Remove two adjacent arcs from each++g103 :: GraphMem LabelMem+g103 = arcsToGraph+       [ t10102, t10203, t10304,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g203 :: GraphMem LabelMem+g203 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803, t20904, t21005,+         t20607, t20708,                 t21006 ]++g303 :: GraphMem LabelMem+g303 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803, t20904,+         t20607, t20708, t20809,         t21006 ]++-- Remove two adjacent arcs from one, non-adjacent from another++g104 :: GraphMem LabelMem+g104 = arcsToGraph+       [ t10102, t10203, t10304,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g204 :: GraphMem LabelMem+g204 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20601, t20702, t20803,+         t20607, t20708, t20809, t20910, t21006 ]++-- Compare two rings of 5 with one ring of 10+-- (each node double-connected, but different overall topology)++t10901 :: Arc LabelMem+t10901 = toStatement v109 p109 v101++g105 :: GraphMem LabelMem+g105 = arcsToGraph+       [ t10102, t10203, t10304, t10405,+                                 t10901, t10510,+         t10607, t10708, t10809,         t11006 ]++g205 :: GraphMem LabelMem+g205 = arcsToGraph+       [ t20102, t20203, t20304, t20405, t20501,+         t20607, t20708, t20809, t20910, t21006 ]++-- Reverse one arc from test 01+-- (also, rearrange arcs to catch ordering artefacts)++t20201 :: Arc LabelMem+t20201 = toStatement v202 p201 v201++g106 :: GraphMem LabelMem+g106 = arcsToGraph+       [ t10102, t10203, t10304, t10405, t10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g206 :: GraphMem LabelMem+g206 = arcsToGraph+       [ t20607, t20708, t20809, t20910, t21006,+         t20601, t20702, t20803, t20904, t21005,+         t20102, t20203, t20304, t20405, t20501 ]++g306 :: GraphMem LabelMem+g306 = arcsToGraph+       [ t20607, t20708, t20809, t20910, t21006,+         t20601, t20702, t20803, t20904, t21005,+         t20201, t20203, t20304, t20405, t20501 ]++-- Similar tests to 02,03,04,+-- but add identified property rather than removing arcs++f01, f02 :: LabelMem+f01  = LF "f01"+f02  = LF "f02"++-- Fix one arc from each++f10102, f10501, f21006, f20510 :: Arc LabelMem+f10102 = toStatement v101 f01 v102+f10501 = toStatement v105 f01 v101+f21006 = toStatement v210 f01 v206+f20510 = toStatement v205 f01 v210++g107 :: GraphMem LabelMem+g107 = arcsToGraph+       [ f10102, t10203, t10304, t10405, t10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g207 :: GraphMem LabelMem+g207 = arcsToGraph+       [ t10102, t10203, t10304, t10405, f10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g307 :: GraphMem LabelMem+g307 = arcsToGraph+       [ t20607, t20708, t20809, t20910, f21006,+         t20601, t20702, t20803, t20904, t21005,+         t20102, t20203, t20304, t20405, t20501 ]++g407 :: GraphMem LabelMem+g407 = arcsToGraph+       [ t20607, t20708, t20809, t20910, t21006,+         t20601, t20702, t20803, t20904, t21005,+         t20102, t20203, t20304, t20405, t20501 ]++-- Fix two adjacent arcs from each++f10203, f10405, f20910, f20601 :: Arc LabelMem+f10203 = toStatement v102 f01 v103+f10405 = toStatement v104 f01 v105+f20910 = toStatement v209 f01 v210+f20601 = toStatement v206 f01 v201++g108 :: GraphMem LabelMem+g108 = arcsToGraph+       [ f10102, f10203, t10304, t10405, t10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g208 :: GraphMem LabelMem+g208 = arcsToGraph+       [ t10102, t10203, t10304, f10405, f10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g308 :: GraphMem LabelMem+g308 = arcsToGraph+       [ t20607, t20708, t20809, f20910, f21006,+         t20601, t20702, t20803, t20904, t21005,+         t20102, t20203, t20304, t20405, t20501 ]++g408 :: GraphMem LabelMem+g408 = arcsToGraph+       [ t20607, t20708, t20809, t20910, f21006,+         f20601, t20702, t20803, t20904, t21005,+         t20102, t20203, t20304, t20405, t20501 ]++-- Fix two adjacent arcs with different properties++g10203, g10102, g10405 :: Arc LabelMem+g10203 = toStatement v102 f02 v103+g10102 = toStatement v101 f02 v102+g10405 = toStatement v104 f02 v105++g109, g209, g309 :: GraphMem LabelMem+g109 = arcsToGraph+       [ f10102, g10203, t10304, t10405, t10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g209 = arcsToGraph+       [ g10102, t10203, t10304, t10405, f10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++g309 = arcsToGraph+       [ t10102, t10203, t10304, g10405, f10501,+         t10106, t10207, t10308, t10409, t10510,+         t10607, t10708, t10809, t10910, t11006 ]++mgeq00 :: Test+mgeq00 = testGraphEq "g100-g200" True  g100 g200++mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156 :: Test+mgeq0112 = testGraphEq "g101-g201" True  g101 g201+mgeq0113 = testGraphEq "g101-g301" False g101 g301+mgeq0114 = testGraphEq "g101-g401" False g101 g401+mgeq0115 = testGraphEq "g101-g501" False g101 g501+mgeq0116 = testGraphEq "g101-g601" False g101 g601+mgeq0156 = testGraphEq "g501-g601" True  g501 g601++mgeq0212, mgeq0213 :: Test+mgeq0212 = testGraphEq "g102-g202" True  g102 g202+mgeq0213 = testGraphEq "g102-g302" False g102 g302++mgeq0312, mgeq0313 :: Test+mgeq0312 = testGraphEq "g103-g203" True  g103 g203+mgeq0313 = testGraphEq "g103-g303" False g103 g303++mgeq04, mgeq05 :: Test+mgeq04 = testGraphEq "g104-g204" False g104 g204+mgeq05 = testGraphEq "g105-g205" False g105 g205++mgeq0612, mgeq0613 :: Test+mgeq0612 = testGraphEq "g106-g206" True  g106 g206+mgeq0613 = testGraphEq "g106-g306" False g106 g306++mgeq0712, mgeq0713, mgeq0714 :: Test+mgeq0712 = testGraphEq "g107-g207" True  g107 g207+mgeq0713 = testGraphEq "g107-g307" True  g107 g307+mgeq0714 = testGraphEq "g107-g407" False g107 g407++mgeq0812, mgeq0813, mgeq0814 :: Test+mgeq0812 = testGraphEq "g108-g208" True  g108 g208+mgeq0813 = testGraphEq "g108-g308" True  g108 g308+mgeq0814 = testGraphEq "g108-g408" False g108 g408++mgeq0912, mgeq0913 :: Test+mgeq0912 = testGraphEq "g109-g209" True  g109 g209+mgeq0913 = testGraphEq "g109-g309" False g109 g309++testGraphEqSuiteMore :: Test+testGraphEqSuiteMore = TestList+  [ mgeq00+  , mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156+  , mgeq0212, mgeq0213+  , mgeq0312, mgeq0313+  , mgeq04+  , mgeq05+  , mgeq0612, mgeq0613+  , mgeq0712, mgeq0713, mgeq0714+  , mgeq0812, mgeq0813, mgeq0814+  , mgeq0912, mgeq0913+  ]++------------------------------------------------------------+-- All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testSelectSuite+  , testMapsetSuite+  , testSubsetSuite+  , testHashSuite+  , testLabSuite+  , testGraphSuite+  , testLabelEqSuite+  , testLabelOrdSuite+  , testStmtEqSuite+  , testLabelMapSuite+  , testGraphMatchSupportSuite+  , testGraphMatchStepSuite+  , testGraphEqSuitePart+  , testGraphEqSuite+  , testGraphEqSuiteMore+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT++geq    = testGraphEqSuite+geq1   = testGraphEqSuiteMore+ttmore = tt testGraphEqSuiteMore    -- this test may take a long time+tfmore = tf testGraphEqSuiteMore+ttstep = tt testGraphMatchStepSuite+tfstep = tf testGraphMatchStepSuite++-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/LookupMapTest.hs view
@@ -0,0 +1,491 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  LookupMapTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  FlexibleInstances, FlexibleContexts, MultiParamTypeClasses+--+-- This Module defines test cases for module Parse parsing functions.+--+--------------------------------------------------------------------------------++module Main where++import Swish.Utils.LookupMap+    ( LookupEntryClass(..), LookupMap(..)+    , makeLookupMap+    , reverseLookupMap+    , mapFind, mapContains+    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap+    , mapAdd, mapAddIfNew+    , mapDelete, mapDeleteAll+    , mapApplyToAll, mapTranslate+    , mapEq, mapKeys, mapVals+    , mapSelect, mapMerge+    , mapTranslateKeys, mapTranslateVals+    , mapTranslateEntries, mapTranslateEntriesM+    )++import Swish.Utils.ListHelpers+    ( equiv )++import Data.List ( sort )++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertEqual, runTestTT )++------------------------------------------------------------+--  Declare lookup entry for testing+------------------------------------------------------------++data GenMapEntry a b = E a b++instance (Eq a, Show a, Eq b, Show b)+    => LookupEntryClass (GenMapEntry a b) a b+    where+        keyVal   (E k v) = (k,v)+        newEntry (k,v)   = (E k v)++instance (Eq a, Show a, Eq b, Show b) => Show (GenMapEntry a b) where+    show = entryShow++instance (Eq a, Show a, Eq b, Show b) => Eq (GenMapEntry a b) where+    (==) = entryEq++type TestEntry  = GenMapEntry Int String+type TestMap    = LookupMap (GenMapEntry Int String)+type RevTestMap = LookupMap (GenMapEntry String Int)+type MayTestMap = Maybe RevTestMap+type StrTestMap = LookupMap (GenMapEntry String String)++------------------------------------------------------------+--  Test class helper+------------------------------------------------------------++testeq :: (Show a, Eq a) => String -> a -> a -> Test+testeq lab req got =+    TestCase ( assertEqual ("test"++lab) req got )++testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test+testeqv lab req got =+    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )++------------------------------------------------------------+--  LookupMap functions+------------------------------------------------------------++newMap :: [(Int,String)] -> TestMap+newMap es = makeLookupMap (map newEntry es)++testLookupMap :: String -> TestMap -> [(Int,String)] -> Test+testLookupMap lab m1 m2 = testeq ("LookupMap"++lab ) (newMap m2) m1++testLookupMapFind :: String -> TestMap -> Int -> String -> Test+testLookupMapFind lab lm k res =+    testeq ("LookupMapFind"++lab ) res (mapFind "" k lm)++lm00, lm01, lm02, lm03, lm04, lm05, lm06, lm07, lm08, lm09 :: TestMap+lm00 = newMap []+lm01 = mapAdd lm00 $ newEntry (1,"aaa")+lm02 = mapAdd lm01 $ newEntry (2,"bbb")+lm03 = mapAdd lm02 $ newEntry (3,"ccc")+lm04 = mapAdd lm03 $ newEntry (2,"bbb")+lm05 = mapReplaceAll lm04 $ newEntry (2,"bbb1")+lm06 = mapReplaceAll lm05 $ newEntry (9,"zzzz")+lm07 = mapReplace lm06 $ newEntry (2,"bbb")+lm08 = mapDelete lm07 3+lm09 = mapDeleteAll lm08 2++la10 :: [String]+la10 = mapApplyToAll lm03 (flip replicate '*')++lt11, lt12, lt13, lt14 :: String+lt11 = mapTranslate lm03 la10 1 "****"+lt12 = mapTranslate lm03 la10 2 "****"+lt13 = mapTranslate lm03 la10 3 "****"+lt14 = mapTranslate lm03 la10 4 "****"++lm20, lm21, lm22, lm33, lm34, lm35, lm36 :: TestMap+lm20 = mapReplaceMap lm05 $ newMap [(2,"bbb20"),(3,"ccc20")]+lm21 = mapReplaceMap lm05 $ newMap []+lm22 = mapReplaceMap lm05 $ newMap [(9,"zzz22"),(1,"aaa22")]+lm33 = mapAddIfNew lm22 $ newEntry (1,"aaa33")+lm34 = mapAddIfNew lm22 $ newEntry (4,"ddd34")+lm35 = mapReplaceOrAdd (newEntry (1,"aaa35")) lm22+lm36 = mapReplaceOrAdd (newEntry (4,"ddd36")) lm22++testLookupMapSuite :: Test+testLookupMapSuite = +  TestList+  [ testLookupMap     "00" lm00 []+  , testLookupMapFind "00" lm00 2 ""+  , testLookupMap     "01" lm01 [(1,"aaa")]+  , testLookupMapFind "01" lm01 2 ""+  , testLookupMap     "02" lm02 [(2,"bbb"),(1,"aaa")]+  , testLookupMapFind "02" lm02 2 "bbb"+  , testLookupMap     "03" lm03 [(3,"ccc"),(2,"bbb"),(1,"aaa")]+  , testLookupMapFind "03" lm03 2 "bbb"+  , testLookupMap     "04" lm04 [(2,"bbb"),(3,"ccc"),(2,"bbb"),(1,"aaa")]+  , testLookupMapFind "04" lm04 2 "bbb"+  , testLookupMap     "05" lm05 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]+  , testLookupMapFind "05" lm05 2 "bbb1"+  , testLookupMap     "06" lm06 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]+  , testLookupMapFind "06" lm06 2 "bbb1"+  , testLookupMap     "07" lm07 [(2,"bbb"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]+  , testLookupMapFind "07" lm07 2 "bbb"+  , testLookupMapFind "0x" lm07 9 ""+  , testLookupMap     "08" lm08 [(2,"bbb"),(2,"bbb1"),(1,"aaa")]+  , testLookupMapFind "08" lm08 2 "bbb"+  , testLookupMap     "09" lm09 [(1,"aaa")]+  , testLookupMapFind "09" lm09 2 ""+  , testeq "LookupMapApplyToAll10" ["***","**","*"] la10+  , testeq "LookupMapTranslate11" "*"   lt11+  , testeq "LookupMapTranslate12" "**"  lt12+  , testeq "LookupMapTranslate13" "***" lt13+  , testeq "LookupMapTranslate14" "****" lt14+  , testLookupMap     "20" lm20 [(2,"bbb20"),(3,"ccc20"),(2,"bbb20"),(1,"aaa")]+  , testLookupMapFind "20" lm20 2 "bbb20"+  , testLookupMap     "21" lm21 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]+  , testLookupMapFind "21" lm21 2 "bbb1"+  , testLookupMap     "22" lm22 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]+  , testLookupMapFind "22" lm22 1 "aaa22"+  , testeq "LookupContains31" True  (mapContains lm22 2)+  , testeq "LookupContains32" False (mapContains lm22 9)+  , testLookupMap      "33" lm33 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]+  , testLookupMapFind "33a" lm33 1 "aaa22"+  , testLookupMapFind "33b" lm33 4 ""+  , testLookupMap      "34" lm34 [(4,"ddd34"),(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]+  , testLookupMapFind "34a" lm34 1 "aaa22"+  , testLookupMapFind "34b" lm34 4 "ddd34"+  , testLookupMap      "35" lm35 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa35")]+  , testLookupMapFind "35a" lm35 1 "aaa35"+  , testLookupMapFind "35b" lm35 4 ""+  , testLookupMap      "36" lm36 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22"),(4,"ddd36")]+  , testLookupMapFind "36a" lm36 1 "aaa22"+  , testLookupMapFind "36b" lm36 4 "ddd36"+  ]++------------------------------------------------------------+--  Reverse lookup map test tests+------------------------------------------------------------++revdef :: Int+revdef = -1++newRevMap :: [(String,Int)] -> RevTestMap+newRevMap es = makeLookupMap (map newEntry es)++testRevLookupMap :: String -> RevTestMap -> [(String,Int)] -> Test+testRevLookupMap lab m1 m2 =+    testeq ("RevLookupMap"++lab) (newRevMap m2) m1++testRevLookupMapFind :: String -> RevTestMap -> String -> Int -> Test+testRevLookupMapFind lab lm k res =+    testeq ("RevLookupMapFind"++lab) res (mapFind revdef k lm)++rlm00 :: RevTestMap+rlm00 = reverseLookupMap lm00++rlm01 :: RevTestMap+rlm01 = reverseLookupMap lm01++rlm02 :: RevTestMap+rlm02 = reverseLookupMap lm02++rlm03 :: RevTestMap+rlm03 = reverseLookupMap lm03++rlm04 :: RevTestMap+rlm04 = reverseLookupMap lm04++rlm05 :: RevTestMap+rlm05 = reverseLookupMap lm05++rlm06 :: RevTestMap+rlm06 = reverseLookupMap lm06++rlm07 :: RevTestMap+rlm07 = reverseLookupMap lm07++rlm08 :: RevTestMap+rlm08 = reverseLookupMap lm08++rlm09 :: RevTestMap+rlm09 = reverseLookupMap lm09++testRevLookupMapSuite :: Test+testRevLookupMapSuite = +  TestList+  [ testRevLookupMap     "00" rlm00 []+  , testRevLookupMapFind "00" rlm00 "" revdef+  , testRevLookupMap     "01" rlm01 [("aaa",1)]+  , testRevLookupMapFind "01" rlm01 "bbb" revdef+  , testRevLookupMap     "02" rlm02 [("bbb",2),("aaa",1)]+  , testRevLookupMapFind "02" rlm02 "bbb" 2+  , testRevLookupMap     "03" rlm03 [("ccc",3),("bbb",2),("aaa",1)]+  , testRevLookupMapFind "03" rlm03 "bbb" 2+  , testRevLookupMap     "04" rlm04 [("bbb",2),("ccc",3),("bbb",2),("aaa",1)]+  , testRevLookupMapFind "04" rlm04 "bbb" 2+  , testRevLookupMap     "05" rlm05 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]+  , testRevLookupMapFind "05" rlm05 "bbb1" 2+  , testRevLookupMap     "06" rlm06 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]+  , testRevLookupMapFind "06" rlm06 "bbb1" 2+  , testRevLookupMap     "07" rlm07 [("bbb",2),("ccc",3),("bbb1",2),("aaa",1)]+  , testRevLookupMapFind "07" rlm07 "bbb" 2+  , testRevLookupMapFind "07" rlm07 "bbb1" 2+  , testRevLookupMapFind "0x" rlm07 "*" revdef+  , testRevLookupMap     "08" rlm08 [("bbb",2),("bbb1",2),("aaa",1)]+  , testRevLookupMapFind "08" rlm08 "bbb" 2+  , testRevLookupMap     "09" rlm09 [("aaa",1)]+  , testRevLookupMapFind "09" rlm09 "" revdef+  ]    ++------------------------------------------------------------+--  mapKeys+------------------------------------------------------------++testMapKeys :: String -> TestMap -> [Int] -> Test+testMapKeys lab m1 mk =+    testeq ("testMapKeys:"++lab) mk (sort $ mapKeys m1)++testMapKeysSuite :: Test+testMapKeysSuite = +  TestList+  [ testMapKeys "00" lm00 []+ ,  testMapKeys "01" lm01 [1]+ ,  testMapKeys "02" lm02 [1,2]+ ,  testMapKeys "03" lm03 [1,2,3]+ ,  testMapKeys "04" lm04 [1,2,3]+ ,  testMapKeys "05" lm05 [1,2,3]+ ,  testMapKeys "06" lm06 [1,2,3]+ ,  testMapKeys "07" lm07 [1,2,3]+ ,  testMapKeys "08" lm08 [1,2]+ ,  testMapKeys "09" lm09 [1]+ ]++------------------------------------------------------------+--  mapVals+------------------------------------------------------------++testMapVals :: String -> TestMap -> [String] -> Test+testMapVals lab m1 mv =+    testeq ("MapVals:"++lab) mv (sort $ mapVals m1)++testMapValsSuite :: Test+testMapValsSuite =+  TestList+  [ testMapVals "00" lm00 []+  , testMapVals "01" lm01 ["aaa"]+  , testMapVals "02" lm02 ["aaa","bbb"]+  , testMapVals "03" lm03 ["aaa","bbb","ccc"]+  , testMapVals "04" lm04 ["aaa","bbb","ccc"]+  , testMapVals "05" lm05 ["aaa","bbb1","ccc"]+  , testMapVals "06" lm06 ["aaa","bbb1","ccc"]+  , testMapVals "07" lm07 ["aaa","bbb","bbb1","ccc"]+  , testMapVals "08" lm08 ["aaa","bbb","bbb1"]+  , testMapVals "09" lm09 ["aaa"]+  ]++------------------------------------------------------------+--  mapEq+------------------------------------------------------------++maplist :: [(String, TestMap)]+maplist =+  [ ("lm00",lm00)+  , ("lm01",lm01)+  , ("lm02",lm02)+  , ("lm03",lm03)+  , ("lm04",lm04)+  , ("lm05",lm05)+  , ("lm06",lm06)+  , ("lm07",lm07)+  , ("lm08",lm08)+  , ("lm09",lm09)+  ]++mapeqlist :: [(String, String)]+mapeqlist =+  [ ("lm01","lm09")+  , ("lm02","lm08")+  , ("lm03","lm04")+  , ("lm03","lm07")+  , ("lm04","lm07")+  , ("lm05","lm06")+  ]++testMapEq :: String -> Bool -> TestMap -> TestMap -> Test+testMapEq lab eq m1 m2 =+    testeq ("testMapEq:"++lab) eq (mapEq m1 m2)++testMapEqSuite :: Test+testMapEqSuite = TestList+  [ testMapEq (testLab l1 l2) (testEq l1 l2) m1 m2+      | (l1,m1) <- maplist , (l2,m2) <- maplist ]+    where+    testLab l1 l2 = l1 ++ "-" ++ l2+    testEq  l1 l2 = (l1 == l2)       ||+            (l1,l2) `elem` mapeqlist ||+            (l2,l1) `elem` mapeqlist++------------------------------------------------------------+--  mapSelect and mapMerge+------------------------------------------------------------++lm101, lm102, lm103, lm104 :: TestMap+lm101 = mapAdd lm03 $ newEntry (4,"ddd")+lm102 = mapSelect lm101 [1,3]+lm103 = mapSelect lm101 [2,4]+lm104 = mapSelect lm101 [2,3]++mapSelectSuite :: Test+mapSelectSuite = +  TestList+  [ testLookupMap "101" lm101 [(4,"ddd"),(3,"ccc"),(2,"bbb"),(1,"aaa")]+  , testLookupMap "102" lm102 [(3,"ccc"),(1,"aaa")]+  , testLookupMap "103" lm103 [(4,"ddd"),(2,"bbb")]+  , testLookupMap "104" lm104 [(3,"ccc"),(2,"bbb")]+  ]+  +lm105, lm106, lm107, lm108 :: TestMap+lm105 = mapMerge lm102 lm103+lm106 = mapMerge lm102 lm104+lm107 = mapMerge lm103 lm104+lm108 = mapMerge lm101 lm102++mapMergeSuite :: Test+mapMergeSuite =+  TestList+  [ testLookupMap "105" lm105 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]+  , testLookupMap "106" lm106 [(1,"aaa"),(2,"bbb"),(3,"ccc")]+  , testLookupMap "107" lm107 [(2,"bbb"),(3,"ccc"),(4,"ddd")]+  , testLookupMap "108" lm108 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]+  ] +  +------------------------------------------------------------+--  Tranlation tests+------------------------------------------------------------++-- Rather late in the day, generic versions of the testing functions used earlier+type TestMapG a b = LookupMap (GenMapEntry a b)++newMapG :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> (TestMapG a b)+newMapG es = makeLookupMap (map newEntry es)++testLookupMapG :: (Eq a, Show a, Eq b, Show b) => String -> (TestMapG a b) -> [(a,b)] -> Test+testLookupMapG lab m1 m2 = testeq ("LookupMapG"++lab ) (newMapG m2) m1+testLookupMapM ::+    (Eq a, Show a, Eq b, Show b, Monad m,+     Eq (m (TestMapG a b)), Show (m (TestMapG a b)))+    => String -> m (TestMapG a b) -> m (TestMapG a b) -> Test+testLookupMapM lab m1 m2 = testeq ("LookupMapM"++lab ) m2 m1++tm101 :: TestMap+tm101 = newMap [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]++tf102 :: Int -> String+tf102 = flip replicate '*'++tm102 :: StrTestMap+tm102 = mapTranslateKeys tf102 tm101++tm103 :: RevTestMap+tm103 = mapTranslateVals length tm102++tf104 :: (LookupEntryClass a Int [b],+          LookupEntryClass c String Int) =>+         a -> c+tf104 e = newEntry ( (flip replicate '#') k, 5-(length v) ) where (k,v) = keyVal e++tm104 :: RevTestMap+tm104 = mapTranslateEntries tf104 tm101++-- Test monadic translation, using Maybe monad+-- (Note that if Nothing is generated at any step,+-- it propagates to the result)+--+tf105 :: (LookupEntryClass a Int [b],+          LookupEntryClass c String Int) =>+         a -> Maybe c+tf105 e = Just $ tf104 e++tm105 :: MayTestMap+tm105 = mapTranslateEntriesM tf105 tm101++tf106 :: (LookupEntryClass a Int [b],+          LookupEntryClass c String Int) =>+         a -> Maybe c+tf106 e = if k == 2 then Nothing else tf105 e where (k,_) = keyVal e++tm106 :: MayTestMap+tm106 = mapTranslateEntriesM tf106 tm101++mapTranslateSuite :: Test+mapTranslateSuite = +  TestList+  [ testLookupMapG "tm101" tm101 [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]+  , testLookupMapG "tm102" tm102 [("*","a"),("**","bb"),("***","ccc"),("****","dddd")]+  , testLookupMapG "tm103" tm103 [("*",1),("**",2),("***",3),("****",4)]+  , testLookupMapG "tm104" tm104 [("#",4),("##",3),("###",2),("####",1)]+  , testLookupMapM "tm105" tm105 (Just tm104)+  , testLookupMapM "tm106" tm106 Nothing+  ] +  +------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testLookupMapSuite+  , testRevLookupMapSuite+  , testMapKeysSuite+  , testMapValsSuite+  , testMapEqSuite+  , mapSelectSuite+  , mapMergeSuite+  , mapTranslateSuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/N3FormatterTest.hs view
@@ -0,0 +1,1309 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  N3FormatterTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module defines test cases for module Parse parsing functions.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.N3Formatter+    ( formatGraphAsStringNl+    , formatGraphAsString+    , formatGraphDiag )++import Swish.RDF.N3Parser (parseN3fromString)++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..), NSGraph(..)+    , NamespaceMap+    , LookupFormula(..)+    , emptyRDFGraph, toRDFGraph+      -- Export selected RDFLabel values+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil+    , res_owl_sameAs+    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    )++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , emptyLookupMap, makeLookupMap )++import Swish.RDF.GraphClass (Arc, arc)++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertEqual, runTestTT )++------------------------------------------------------------+--  Common test wrappers+------------------------------------------------------------++testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test+testLabelEq lab eq n1 n2 =+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )++testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test+testGraphEq lab eq gg1 gg2 =+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )++------------------------------------------------------------+--  Define some common values+------------------------------------------------------------++base1, base2, base3, base4 :: Namespace+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"++s1, s2, s3 :: RDFLabel+s1 = Res $ ScopedName base1 "s1"+s2 = Res $ ScopedName base2 "s2"+s3 = Res $ ScopedName base3 "s3"++b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel+b1 = Blank "b1"+b2 = Blank "b2"+b3 = Blank "b3"+b4 = Blank "b4"+b5 = Blank "b5"+b6 = Blank "b6"+b7 = Blank "b7"+b8 = Blank "b8"++c1, c2, c3, c4, c5, c6 :: RDFLabel+c1 = Blank "c1"+c2 = Blank "c2"+c3 = Blank "c3"+c4 = Blank "c4"+c5 = Blank "c5"+c6 = Blank "c6"++p1, p2, p3, p21, p22, p23, p24, p25, p26 :: RDFLabel+p1  = Res $ ScopedName base1 "p1"+p2  = Res $ ScopedName base2 "p2"+p3  = Res $ ScopedName base3 "p3"+p21 = Res $ ScopedName base2 "p21"+p22 = Res $ ScopedName base2 "p22"+p23 = Res $ ScopedName base2 "p23"+p24 = Res $ ScopedName base2 "p24"+p25 = Res $ ScopedName base2 "p25"+p26 = Res $ ScopedName base2 "p26"++o1, o2, o3 :: RDFLabel+o1 = Res $ ScopedName base1 "o1"+o2 = Res $ ScopedName base2 "o2"+o3 = Res $ ScopedName base3 "o3"++l1txt, l2txt, l3txt, l11txt, l12txt, l13txt, l14txt :: String+l1txt = "l1"+l2txt = "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'"+l3txt = "l3--\r\"'\\--\x0020\&--\x00A0\&--"+l11txt = "lx11"+l12txt = "lx12"+l13txt = "lx13"+l14txt = "lx14"++l1, l2, l3, l11, l12, l13, l14 :: RDFLabel+l1  = Lit l1txt  Nothing+l2  = Lit l2txt  Nothing+l3  = Lit l3txt  Nothing+l11 = Lit l11txt Nothing+l12 = Lit l12txt Nothing+l13 = Lit l13txt Nothing+l14 = Lit l14txt Nothing++f1, f2 :: RDFLabel+f1 = Res $ ScopedName base1 "f1"+f2 = Res $ ScopedName base2 "f2"++v1, v2, v3, v4 :: RDFLabel+v1 = Var "var1"+v2 = Var "var2"+v3 = Var "var3"+v4 = Var "var4"++------------------------------------------------------------+--  Construct graphs for testing+------------------------------------------------------------++t01, t02, t03, t04, t05, t06, t07 :: Arc RDFLabel+t01 = arc s1 p1 o1+t02 = arc s2 p1 o2+t03 = arc s3 p1 o3+t04 = arc s1 p1 l1+t05 = arc s2 p1 b1+t06 = arc s3 p1 l2+t07 = arc s3 p2 l3++nslist :: NamespaceMap+nslist = makeLookupMap+    [ base1+    , base2+    , base3+    , base4+    ]++g1np :: RDFGraph+g1np = toRDFGraph [t01]++toGraph :: [Arc RDFLabel] -> RDFGraph+toGraph arcs = (toRDFGraph arcs) {namespaces = nslist}++g1, g1b1, g1b3, g1a1, g1l1, g1l2 :: RDFGraph+g1   = toGraph [t01]+g1b1 = toGraph [arc b1 p1 o1]+g1b3 = toGraph [arc b1 b2 b3]+g1a1 = toGraph [arc (Blank "1") p1 o1]+g1l1 = toGraph [arc s1 p1 l1]+g1l2 = toGraph [arc s1 p1 l2]++{-+g1f1 = NSGraph+        { namespaces = nslist+        , formulae   = formo1g1+        , statements = [f01]+        }+    where+        f01      = arc s1 p1 o1+        formo1g1 = LookupMap [Formula o1 g1]+-}++g1f2, g1f3 :: RDFGraph+g1f2 = NSGraph+        { namespaces = nslist+        , formulae   = formb2g1+        , statements = [f02]+        }+    where+        f02 = arc s1 p1 b2+        formb2g1 = LookupMap [Formula b2 g1]++g1f3 = NSGraph+        { namespaces = nslist+        , formulae   = formb3g1f2+        , statements = [f02]+        }+    where+        f02 = arc s1 p1 b3+        formb3g1f2 = LookupMap [Formula b3 g1f2]++----++g2, g3, g4, g5, g6, g7 :: RDFGraph+g2 = toGraph [t01,t02,t03]+g3 = toGraph [t01,t04]+g4 = toGraph [t01,t05]+g5 = toGraph [t01,t02,t03,t04,t05]+g6 = toGraph [t01,t06]+g7 = toGraph [t01,t07]++t801, t802, t807, t808, t809, t810 :: Arc RDFLabel+t801 = arc s1 res_rdf_type       o1+t802 = arc s2 res_owl_sameAs     o2+t807 = arc o1 p1 s1+t808 = arc s2 p1 o2+t809 = arc s1 p2 o1+t810 = arc o2 p2 s2++g8, g81, g83 :: RDFGraph+g8  = toGraph [t801,t802,t807,t808,t809,t810]+g81 = toGraph [t801,t802]+g83 = toGraph [t807,t808,t809,t810]++t911, t912, t913, t914, t921, t922, t923, t924,+  t925, t926, t927, t928 :: Arc RDFLabel+t911 = arc s1 p1 o1+t912 = arc s1 p1 o2+t913 = arc s1 p2 o2+t914 = arc s1 p2 o3+t921 = arc s2 p1 o1+t922 = arc s2 p1 o2+t923 = arc s2 p1 o3+t924 = arc s2 p1 l1+t925 = arc s2 p2 o1+t926 = arc s2 p2 o2+t927 = arc s2 p2 o3+t928 = arc s2 p2 l1++g9 :: RDFGraph+g9 = toGraph [t911,t912,t913,t914,+              t921,t922,t923,t924,+              t925,t926,t927,t928]++t1011, t1012, t1013, t1014, t1021, t1022, t1023, t1024,+  t1025, t1026, t1027, t1028 :: Arc RDFLabel+t1011 = arc s1 p1 o1+t1012 = arc o2 p1 s1+t1013 = arc s1 p2 o2+t1014 = arc o3 p2 s1+t1021 = arc s2 p1 o1+t1022 = arc s2 p1 o2+t1023 = arc s2 p1 o3+t1024 = arc s2 p1 l1+t1025 = arc o1 p2 s2+t1026 = arc o2 p2 s2+t1027 = arc o3 p2 s2+-- t1028 = arc l1 p2 s2+t1028 = arc s1 p2 s2++g10 :: RDFGraph+g10 = toGraph [t1011,t1012,t1013,t1014,+               t1021,t1022,t1023,t1024,+               t1025,t1026,t1027,t1028]++g11 :: RDFGraph+g11 = toGraph [ arc s1 p1 v1+              , arc v2 p1 o1+              , arc v3 p1 v4]++tx101, tx102, tx111, tx112, tx113, tx114,+  tx121, tx122, tx123, tx124, tx125, tx126,+  tx127, tx128 :: Arc RDFLabel+tx101 = arc b1 res_owl_sameAs s1+tx102 = arc s2 res_owl_sameAs b2+tx111 = arc b1 p1 o1+tx112 = arc b1 p1 o2+tx113 = arc b1 p2 o2+tx114 = arc b1 p2 o3+tx121 = arc b2 p1 o1+tx122 = arc b2 p1 o2+tx123 = arc b2 p1 o3+tx124 = arc b2 p1 l1+tx125 = arc b2 p2 o1+tx126 = arc b2 p2 o2+tx127 = arc b2 p2 o3+tx128 = arc b2 p2 l2++x1 :: RDFGraph+x1 = toGraph [tx101,tx102,+              tx111,tx112,tx113,tx114,+              tx121,tx122,tx123,tx124,+              tx125,tx126,tx127,tx128]++tx201, tx202, tx211, tx212, tx213, tx214,+  tx221, tx222, tx223, tx224, tx225, tx226,+  tx227 :: Arc RDFLabel+tx201 = arc b1 res_owl_sameAs s1+tx202 = arc s2 res_owl_sameAs b2+tx211 = arc b1 p1 o1+tx212 = arc o2 p1 b1+tx213 = arc b1 p2 o2+tx214 = arc o3 p2 b1+tx221 = arc b2 p1 o1+tx222 = arc b2 p1 o2+tx223 = arc b2 p1 o3+tx224 = arc b2 p1 l1+tx225 = arc o1 p2 b2+tx226 = arc o2 p2 b2+tx227 = arc o3 p2 b2+-- tx228 = arc l1 p2 b2++x2 :: RDFGraph+x2 = toGraph [tx201,tx202,+              tx211,tx212,tx213,tx214,+              tx221,tx222,tx223,tx224,+              tx225,tx226,tx227]++tx311, tx312, tx313, tx314,+  tx321, tx322, tx323, tx324, tx325, tx326,+  tx327 :: Arc RDFLabel+tx311 = arc s1 p1 o1+tx312 = arc o2 p1 s1+tx313 = arc s1 p2 o2+tx314 = arc o3 p2 s1+tx321 = arc s2 p1 o1+tx322 = arc s2 p1 o2+tx323 = arc s2 p1 o3+tx324 = arc s2 p1 l1+tx325 = arc o1 p2 s2+tx326 = arc o2 p2 s2+tx327 = arc o3 p2 s2+-- tx328 = arc l1 p2 s2++x3 :: RDFGraph+x3 = toGraph [tx311,tx312,tx313,tx314,+              tx321,tx322,tx323,tx324,+              tx325,tx326,tx327]++tx401, tx402, tx403, tx404, tx405, tx406,+  tx407, tx408, tx409 :: Arc RDFLabel+tx401 = arc s1 res_owl_sameAs b1+tx402 = arc b1 res_rdf_first  o1+tx403 = arc b1 res_rdf_rest   b2+tx404 = arc b2 res_rdf_first  o2+tx405 = arc b2 res_rdf_rest   b3+tx406 = arc b3 res_rdf_first  o3+tx407 = arc b3 res_rdf_rest   b4+tx408 = arc b4 res_rdf_first  l1+tx409 = arc b4 res_rdf_rest   res_rdf_nil++x4 :: RDFGraph+x4 = toGraph [tx401,tx402,tx403,tx404,+              tx405,tx406,tx407,tx408,+              tx409]++x5 :: RDFGraph+x5 = toGraph [ arc b1 res_owl_sameAs s1+             , arc b1 res_rdf_first  o1+             , arc b1 res_rdf_rest   b2+             , arc b2 res_rdf_first  o2+             , arc b2 res_rdf_rest   b3+             , arc b3 res_rdf_first  o3+             , arc b3 res_rdf_rest   b4+             , arc b4 res_rdf_first  l1+             , arc b4 res_rdf_rest   res_rdf_nil+             ]++{-+I was aiming for++:s1     =  (+        :o1+        b2:o2+        b3:o3+        "l1" ) .++but really it's++:s1 rdf:first ( b1:o1 b2:o2 b3:o3 "l1" ) .++or something like that. different versions of+cwm parse the triples differently, and it depends+on the output format too (eg n3 vs ntriples).+-}++x6 :: RDFGraph+x6 = toGraph [ arc s1 res_rdf_first o1+             , arc s1 res_rdf_rest  b2+             , arc b2 res_rdf_first o2+             , arc b2 res_rdf_rest  b3+             , arc b3 res_rdf_first o3+             , arc b3 res_rdf_rest  b4+             , arc b4 res_rdf_first l1+             , arc b4 res_rdf_rest  res_rdf_nil+             ]++x7 :: RDFGraph+x7 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 g2]+        , statements = [arc b1 p2 f2]+        }++x8 :: RDFGraph+x8 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula f1 g2]+        , statements = [arc f1 p2 f2]+        }++x9 :: RDFGraph+x9 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula f1 g1]+        , statements = [arc f1 p2 f2]+        }+        +--  Test allocation of bnodes carries over a nested formula++x12, x12fg :: RDFGraph+x12    = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b2 x12fg]+        , statements = [ arc s1 p1 b1+                       , arc b1 p1 o1+                       , arc b2 p2 f2+                       , arc s3 p3 b3+                       , arc b3 p3 o3+                       ]+        }++x12fg  = toRDFGraph [ arc s2 p2 b4+                    , arc b4 p2 o2+                    ]+        +--  List of simple anon nodes++x13 :: RDFGraph+x13 = toGraph [ arc s1 res_rdf_first b1+              , arc s1 res_rdf_rest  c1+              , arc c1 res_rdf_first b2+              , arc c1 res_rdf_rest  c2+              , arc c2 res_rdf_first b3+              , arc c2 res_rdf_rest  res_rdf_nil+              , arc b1 p1 o1+              , arc b2 p1 o2+              , arc b3 p1 o3+              ]++--  List of simple anon nodes using autogenerated bnodes++x13a :: RDFGraph+x13a = toGraph [ arc s1  res_rdf_first b_1+               , arc s1  res_rdf_rest  c_1+               , arc c_1 res_rdf_first b_2+               , arc c_1 res_rdf_rest  c_2+               , arc c_2 res_rdf_first b_3+               , arc c_2 res_rdf_rest  res_rdf_nil+               , arc b_1 p1 o1+               , arc b_2 p1 o2+               , arc b_3 p1 o3+               ]+  where+    b_1 = Blank "1"+    b_2 = Blank "2"+    b_3 = Blank "3"+    c_1 = Blank "4"+    c_2 = Blank "5"++--  List of more complex anon nodes++x14 :: RDFGraph+x14 = toGraph [ arc s1 res_rdf_first b1+              , arc s1 res_rdf_rest  c1+              , arc c1 res_rdf_first b2+              , arc c1 res_rdf_rest  c2+              , arc c2 res_rdf_first b3+              , arc c2 res_rdf_rest  res_rdf_nil+              , arc b1 p1 o1+              , arc b1 p2 o1+              , arc b2 p1 o2+              , arc b2 p2 o2+              , arc b3 p1 o3+              , arc b3 p2 o3+              ]++--  List with nested list++x15 :: RDFGraph+x15 = toGraph [ arc s1 res_rdf_first b1+              , arc s1 res_rdf_rest  c1+              , arc c1 res_rdf_first b2+              , arc c1 res_rdf_rest  c2+              , arc c2 res_rdf_first b3+              , arc c2 res_rdf_rest  res_rdf_nil+              , arc b1 p1 o1+              , arc b2 p2 c3+              , arc b3 p1 o3++              , arc c3 res_rdf_first b4+              , arc c3 res_rdf_rest  c4+              , arc c4 res_rdf_first b5+              , arc c4 res_rdf_rest  c5+              , arc c5 res_rdf_first b6+              , arc c5 res_rdf_rest  res_rdf_nil+              , arc b4 p1 o1+              , arc b5 p1 o2+              , arc b6 p1 o3+              ]++--  More complex list with nested list++x16 :: RDFGraph+x16 = toGraph [ arc s1 res_rdf_first b1+              , arc s1 res_rdf_rest  c1+              , arc c1 res_rdf_first b2+              , arc c1 res_rdf_rest  c2+              , arc c2 res_rdf_first b3+              , arc c2 res_rdf_rest  res_rdf_nil+              , arc b1 p1 o1+              , arc b1 p2 o1+              , arc b2 p2 c3+              , arc b3 p1 o3+              , arc b3 p2 o3++              , arc c3 res_rdf_first b4+              , arc c3 res_rdf_rest  c4+              , arc c4 res_rdf_first b5+              , arc c4 res_rdf_rest  c5+              , arc c5 res_rdf_first b6+              , arc c5 res_rdf_rest  res_rdf_nil+              , arc b4 p1 o1+              , arc b4 p2 o1+              , arc b5 p1 o2+              , arc b5 p2 o2+              , arc b6 p1 o3+              , arc b6 p2 o3+              ]++--  Troublesome example++x17 :: RDFGraph+x17 = toGraph [ arc s1 res_rdf_type  o1+              , arc s1 res_rdf_first b1+              , arc s1 res_rdf_rest  c1+              , arc c1 res_rdf_first b2+              , arc c1 res_rdf_rest  res_rdf_nil++              , arc b1 p21 o2+              , arc b1 p22 c2++              , arc b2 p24 o3+              , arc b2 p25 l13++              , arc c2 res_rdf_first b3+              , arc c2 res_rdf_rest  c3+              , arc c3 res_rdf_first l12+              , arc c3 res_rdf_rest  res_rdf_nil++              , arc b3 p23 l11+              ]++-- collection graphs++graph_c1, graph_c1rev, graph_c2, graph_c2rev,+  graph_c3 :: RDFGraph+graph_c1    = toGraph [arc s1 p1 res_rdf_nil]+graph_c1rev = toGraph [arc res_rdf_nil p1 o1]+graph_c2    = toGraph [arc s1 p1 b1,+                       arc b1 res_rdf_first l1,+                       arc b1 res_rdf_rest b2,+                       arc b2 res_rdf_first o2,+                       arc b2 res_rdf_rest b3,+                       arc b3 res_rdf_first l2,+                       arc b3 res_rdf_rest b4,+                       arc b4 res_rdf_first o3,+                       arc b4 res_rdf_rest res_rdf_nil]+graph_c2rev = toGraph [arc b1 res_rdf_first l1,+                       arc b1 res_rdf_rest b2,+                       arc b2 res_rdf_first o2,+                       arc b2 res_rdf_rest b3,+                       arc b3 res_rdf_first l2,+                       arc b3 res_rdf_rest b4,+                       arc b4 res_rdf_first o3,+                       arc b4 res_rdf_rest res_rdf_nil,+                       arc b1 p1 o1]+graph_c3    = toGraph [arc s1 p1 b1,+                       arc b1 res_rdf_first l1,+                       arc b1 res_rdf_rest b2,+                       arc b2 res_rdf_first o2,+                       arc b2 res_rdf_rest b3,+                       arc b3 res_rdf_first l2,+                       arc b3 res_rdf_rest b4,+                       arc b4 res_rdf_first o3,+                       arc b4 res_rdf_rest res_rdf_nil,+                       arc s1 p2 res_rdf_nil,+                       arc s2 p2 o2]++-- bnode graphs++graph_b1, graph_b1rev, graph_b2, graph_b2rev, graph_b3 :: RDFGraph+graph_b1    = toGraph [arc s1 p1 b1]+graph_b1rev = toGraph [arc b1 p1 o1]+graph_b2    = toGraph [arc s1 p1 b1,+                       arc b1 p2 l1,+                       arc b1 o2 o3]+graph_b2rev = toGraph [arc b1 p2 l1,+                       arc b1 o2 o3,+                       arc b1 p1 o1]+graph_b3    = toGraph [arc s1 p1 b1,+                       arc b1 p2 l2,+                       arc b1 o2 o3,+                       arc s1 p2 b2,+                       arc s2 p2 o2]++------------------------------------------------------------+--  Trivial formatter tests+------------------------------------------------------------+--+--  These are very basic tests that confirm that output for a+--  simple graph corresponds exactly to some supplied string.++formatTest :: String -> RDFGraph -> String -> Test+formatTest lab gr out =+    TestList+      [ TestCase ( assertEqual ("formatTest:"++lab) out res )+      ]+    where+      res = formatGraphAsStringNl gr++diagTest :: String -> RDFGraph -> String -> Test+diagTest lab gr out =+    TestList+      [ TestCase ( assertEqual ("diag:text:"++lab) out (res "") )+      , TestCase ( assertEqual ("diag:map:"++lab) emptyLookupMap nmap )+      , TestCase ( assertEqual ("diag:gen:"++lab) 0 ngen )+      , TestCase ( assertEqual ("diag:trc:"++lab) [] trc )+      ]+    where+      (res,nmap,ngen,trc) = formatGraphDiag gr++commonPrefixes :: String+commonPrefixes =+    "@prefix base1: <" ++ nsURI base1 ++ "> .\n" +++    "@prefix base2: <" ++ nsURI base2 ++ "> .\n" +++    "@prefix base3: <" ++ nsURI base3 ++ "> .\n" +++    "@prefix base4: <" ++ nsURI base4 ++ "> .\n"++--  Single statement using <uri> form+simpleN3Graph_g1_01 :: String+simpleN3Graph_g1_01 =+    "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> " +++    "<http://id.ninebynine.org/wip/2003/test/graph1/node#p1> " +++    "<http://id.ninebynine.org/wip/2003/test/graph1/node#o1> .\n"++--  Single statement using prefix:name form+simpleN3Graph_g1_02 :: String+simpleN3Graph_g1_02 =+    commonPrefixes +++    "base1:s1 base1:p1 base1:o1 .\n"++--  Single blank node+simpleN3Graph_g1_03 :: String+simpleN3Graph_g1_03 =+    commonPrefixes +++    "[\n base1:p1 base1:o1\n] .\n"+    -- "_:b1 base1:p1 base1:o1 .\n"++--  Single auto-allocated blank node+simpleN3Graph_g1_04 :: String+simpleN3Graph_g1_04 =+    commonPrefixes +++    "[\n base1:p1 base1:o1\n] .\n"+    -- "_:_1 base1:p1 base1:o1 .\n"++--  Single literal object+simpleN3Graph_g1_05 :: String+simpleN3Graph_g1_05 =+    commonPrefixes +++    "base1:s1 base1:p1 \"l1\" .\n"++--  Single multiline literal object+simpleN3Graph_g1_06 :: String+simpleN3Graph_g1_06 =+    commonPrefixes +++    "base1:s1 base1:p1 \"l2-'\\\"line1\\\"'\\n\\nl2-'\\\"\\\"line2\\\"\\\"'\" .\n"++-- this 'round trips' into a triple-quoted string+simpleN3Graph_g1_06_rt :: String+simpleN3Graph_g1_06_rt =+    commonPrefixes +++    "base1:s1 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" .\n"++{-+--  Single statement with formula node+simpleN3Graph_g1_07 =+    commonPrefixes +++    "base1:s1 base1:p1 base1:o1 .\n"+++    "base1:o1 :-\n"+++    "    {\n"+++    "    base1:s1 base1:p1 base1:o1\n"+++    "    } .\n"++-}++--  Single statement with formula blank node+simpleN3Graph_g1_08 :: String+simpleN3Graph_g1_08 =+    commonPrefixes +++    "base1:s1 base1:p1  { \n"+++    "    base1:s1 base1:p1 base1:o1\n"+++    " }  .\n"+    +--  Three blank nodes (or is that blind mice?)+simpleN3Graph_g1_09 :: String+simpleN3Graph_g1_09 =+    commonPrefixes +++    "[\n _:b2 []\n] .\n"+    -- "_:b1 _:b2 _:b3 .\n"++--  Simple nested formula case+simpleN3Graph_g1_10 :: String+simpleN3Graph_g1_10 =+    commonPrefixes +++    "base1:s1 base1:p1  { \n"           +++    "    base1:s1 base1:p1  { \n"       +++    "        base1:s1 base1:p1 base1:o1\n" +++    "     } \n"                          +++    " }  .\n"++{-+Simple troublesome case+-}+    +simpleN3Graph_x13a :: String+simpleN3Graph_x13a =+    commonPrefixes +++    "base1:s1 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> " ++ b1s ++ " ;\n"+++    "         <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> ( " ++ b2s ++ " " ++ b3s ++ " ) .\n"+    where+      b1s = "[\n base1:p1 base1:o1\n]"+      b2s = "[\n base1:p1 base2:o2\n]"+      b3s = "[\n base1:p1 base3:o3\n]"++{-+Simple collection tests; may replicate some of the+previous tests.+-}++simpleN3Graph_c1 :: String+simpleN3Graph_c1 =+    commonPrefixes +++    "base1:s1 base1:p1 () .\n"++simpleN3Graph_c1rev :: String+simpleN3Graph_c1rev =+    commonPrefixes +++    "() base1:p1 base1:o1 .\n"++collItems :: String+collItems = "( \"l1\" base2:o2 \"\"\"" ++ l2txt ++ "\"\"\" base3:o3 )"++simpleN3Graph_c2 :: String+simpleN3Graph_c2 =+    commonPrefixes +++    "base1:s1 base1:p1 " ++ collItems ++ " .\n"++simpleN3Graph_c2rev :: String+simpleN3Graph_c2rev =+    commonPrefixes +++    collItems ++ " base1:p1 base1:o1 .\n"++simpleN3Graph_c3 :: String+simpleN3Graph_c3 =+    commonPrefixes +++    "base1:s1 base1:p1 " ++ collItems ++ " ;\n" +++    "         base2:p2 () .\n" +++    "base2:s2 base2:p2 base2:o2 .\n"++{-+Simple bnode tests; may replicate some of the+previous tests.+-}++simpleN3Graph_b1 :: String+simpleN3Graph_b1 =+    commonPrefixes +++    "base1:s1 base1:p1 [] .\n"++simpleN3Graph_b1rev :: String+simpleN3Graph_b1rev =+    commonPrefixes +++    "[\n base1:p1 base1:o1\n] .\n"++simpleN3Graph_b2 :: String+simpleN3Graph_b2 =+    commonPrefixes +++    "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n"++simpleN3Graph_b2rev :: String+simpleN3Graph_b2rev =+    commonPrefixes +++    "[\n base1:p1 base1:o1 ;\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n"++simpleN3Graph_b3 :: String+simpleN3Graph_b3 =+    commonPrefixes +++    "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"\"\"" ++ l2txt ++ "\"\"\"\n] ;\n" +++    "         base2:p2 [] .\n" +++    "base2:s2 base2:p2 base2:o2 .\n"++-- diag13 = diagTest "trivialTest13" x13a simpleN3Graph_x13a++trivialTestSuite :: Test+trivialTestSuite = TestList+ [ formatTest "trivialTest01" g1np simpleN3Graph_g1_01+ , formatTest "trivialTest02" g1   simpleN3Graph_g1_02+ , formatTest "trivialTest03" g1b1 simpleN3Graph_g1_03+ , formatTest "trivialTest04" g1a1 simpleN3Graph_g1_04+ , formatTest "trivialTest05" g1l1 simpleN3Graph_g1_05+ , formatTest "trivialTest06" g1l2 simpleN3Graph_g1_06_rt+   -- trivialTest07 = formatTest "trivialTest07" g1f1 simpleN3Graph_g1_07 -- formula is a named node+ , formatTest "trivialTest08" g1f2 simpleN3Graph_g1_08+ , formatTest "trivialTest09" g1b3 simpleN3Graph_g1_09+ , formatTest "trivialTest10" g1f3 simpleN3Graph_g1_10+ , formatTest "trivialTest13a" x13a simpleN3Graph_x13a++ , formatTest "trivialTestc1" graph_c1 simpleN3Graph_c1+ , formatTest "trivialTestc2" graph_c2 simpleN3Graph_c2+ , formatTest "trivialTestc3" graph_c3 simpleN3Graph_c3+ , formatTest "trivialTestc1rev" graph_c1rev simpleN3Graph_c1rev+ , formatTest "trivialTestc2rev" graph_c2rev simpleN3Graph_c2rev++ , formatTest "trivialTestb1" graph_b1 simpleN3Graph_b1+ , formatTest "trivialTestb2" graph_b2 simpleN3Graph_b2+ , formatTest "trivialTestb3" graph_b3 simpleN3Graph_b3+ , formatTest "trivialTestb1rev" graph_b1rev simpleN3Graph_b1rev+ , formatTest "trivialTestb2rev" graph_b2rev simpleN3Graph_b2rev++ , formatTest "trivialTestx4" x4 exoticN3Graph_x4+ , formatTest "trivialTestx5" x5 exoticN3Graph_x5+ , formatTest "trivialTestx7" x7 exoticN3Graph_x7+   + ]++------------------------------------------------------------+--  Parser tests to cross-check round-trip testing+------------------------------------------------------------++parseTest :: String -> String -> RDFGraph -> String -> Test+parseTest lab inp gr er =+    TestList+      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )+      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )+      ]+    where+        (pe,pg) = case parseN3fromString inp of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++noError, errorText :: String+noError   = ""+errorText = "*"++parseTestSuite :: Test+parseTestSuite = TestList+  [ parseTest "01" simpleN3Graph_g1_01 g1np noError+  , parseTest "02" simpleN3Graph_g1_02 g1   noError+  , parseTest "03" simpleN3Graph_g1_03 g1b1 noError+  , parseTest "04" simpleN3Graph_g1_04 g1a1 noError+  , parseTest "05" simpleN3Graph_g1_05 g1l1 noError+  , parseTest "06" simpleN3Graph_g1_06 g1l2 noError+  , parseTest "06rt" simpleN3Graph_g1_06_rt g1l2 noError+    -- parseTest07 = parseTest "07" simpleN3Graph_g1_07 g1f1 noError -- formula is a named node+  , parseTest "08" simpleN3Graph_g1_08 g1f2 noError+  ]++------------------------------------------------------------+--  Repeat above tests using parser and graph-comparison+------------------------------------------------------------+--+--  This establishes a framework that will be used for+--  more complex tests that are less susceptible to trivial+--  formatting differences.  The idea is to generate output+--  that can be parsed to obtain an equivalent graph.++roundTripTest :: String -> RDFGraph -> Test+roundTripTest lab gr =+    TestList+      [ TestCase ( assertEqual ("RoundTrip:gr:"++lab) gr pg )+      , TestCase ( assertEqual ("RoundTrip:er:"++lab) "" pe )+      -- , TestCase ( assertEqual ("Formatted:"++lab) "" out )+      ]+    where+        out     = formatGraphAsString gr+        (pe,pg) = case parseN3fromString out of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++--  Full round trip from graph source.  This test may pick up some errors+--  the bnode generation logic that are not tested by hand-assembled graph+--  data structures.+fullRoundTripTest :: String -> String -> Test+fullRoundTripTest lab grstr =+    TestList+      [ TestCase ( assertEqual ("FullRoundTrip:gr:"++lab) gr pg )+      , TestCase ( assertEqual ("FullRoundTrip:er:"++lab) "" pe )+      -- , TestCase ( assertEqual ("FullRoundTrip:"++lab) "" out )+      ]+    where+        (_,gr) = case parseN3fromString grstr of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)+        out     = formatGraphAsString gr+        (pe,pg) = case parseN3fromString out of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++roundTripTestSuite :: Test+roundTripTestSuite = TestList+  [ roundTripTest "01" g1np+  , roundTripTest "02" g1+  , roundTripTest "03" g1b1+  , roundTripTest "04" g1a1+  , roundTripTest "05" g1l1+  , roundTripTest "06" g1l2+    -- roundTripTest07 = roundTripTest "07" g1f1 -- formula is a named node+  , roundTripTest "08" g1f2+  , fullRoundTripTest "11" simpleN3Graph_g1_01+  , fullRoundTripTest "12" simpleN3Graph_g1_02+  , fullRoundTripTest "13" simpleN3Graph_g1_03+  , fullRoundTripTest "14" simpleN3Graph_g1_04+  , fullRoundTripTest "15" simpleN3Graph_g1_05+  , fullRoundTripTest "16rt" simpleN3Graph_g1_06_rt+    -- roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07 -- TODO: :- with named node for formula+  , fullRoundTripTest "18" simpleN3Graph_g1_08+  ]++------------------------------------------------------------+--  Simple formatter tests+------------------------------------------------------------+--+--  These are simple tests that format and re-parse a graph,+--  and make sure that the result graph compares the same as+--  the original.  Therefore, depends on a trusted parser and+--  graph compare function.++simpleTest :: String -> RDFGraph -> Test+simpleTest lab = roundTripTest ("SimpleTest:"++lab)++simpleTestSuite :: Test+simpleTestSuite = TestList+  [ simpleTest "01" g2+  , simpleTest "02" g3+  , simpleTest "03" g4+  , simpleTest "04" g5+  , simpleTest "05" g6+  , simpleTest "06" g7+  , simpleTest "07" g8+  , simpleTest "08" g81+  , simpleTest "10" g83+  , simpleTest "11" g9+  , simpleTest "12" g10+  , simpleTest "13" g11+  ]++------------------------------------------------------------+--  Exotic parser tests+------------------------------------------------------------+--+--  These tests cover various forms of anonymous nodes+--  [...], lists and formulae.+--++-- does a round-trip test starting with the+exoticTest :: String -> RDFGraph -> Test+exoticTest lab gr =+    TestList+      [ TestCase ( assertEqual ("ExoticTest:gr:"++lab) gr pg )+      , TestCase ( assertEqual ("ExoticTest:er:"++lab) "" pe )+      -- , TestCase ( assertEqual ("ExoticTest:"++lab)    "" out )+      ]+    where+        out     = formatGraphAsString gr+        (pe,pg) = case parseN3fromString out of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++--  Simple anon nodes, with semicolons and commas+exoticN3Graph_x1 :: String+exoticN3Graph_x1 =+    commonPrefixes +++    " [ base1:p1 base1:o1 ; \n" +++    "   base1:p1 base2:o2 ; \n" +++    "   base2:p2 base2:o2 ; \n" +++    "   base2:p2 base3:o3 ] = base1:s1 . \n" +++    " base2:s2 = \n" +++    " [ base1:p1 base1:o1 , \n" +++    "   base2:o2 , \n" +++    "   base3:o3 , \n" +++    "   \"l1\"   ; \n" +++    "   base2:p2 base1:o1 , \n" +++    "            base2:o2 , \n" +++    "            base3:o3 , \n" +++    "            \"\"\"" ++ l2txt ++ "\"\"\"   ] . \n"++--  Simple anon nodes, with 'is ... of' and semicolons and commas+exoticN3Graph_x2 :: String+exoticN3Graph_x2 =+    commonPrefixes +++    " [ @has base1:p1     base1:o1 ; \n" +++    "   @is  base1:p1 @of base2:o2 ; \n" +++    "   @has base2:p2     base2:o2 ; \n" +++    "   @is  base2:p2 @of base3:o3 ] = base1:s1 . \n" +++    " base2:s2 = \n" +++    " [ @has base1:p1 base1:o1 , \n" +++    "                 base2:o2 , \n" +++    "                 base3:o3 , \n" +++    "                 \"l1\"   ; \n" +++    "   @is  base2:p2 @of base1:o1 , \n" +++    "                     base2:o2 , \n" +++    "                     base3:o3 ] . \n"+    -- "                   \"l1\"   ] . \n"++--  Simple anon nodes, attached to identified node+{-+exoticN3Graph_x3 =+    commonPrefixes +++    " base1:s1 :- \n" +++    " [ has base1:p1 of base1:o1 ; \n" +++    "   is  base1:p1 of base2:o2 ; \n" +++    "   has base2:p2 of base2:o2 ; \n" +++    "   is  base2:p2 of base3:o3 ] . \n" +++    " base2:s2 :- \n" +++    " [ has base1:p1 of base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 , \n" +++    "                   \"l1\"   ; \n" +++    "   is  base2:p2 of base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 ] . \n"+    -- "                   \"l1\"   ] . \n"+-}++--  List nodes, with and without :-++exoticN3Graph_x4 :: String+exoticN3Graph_x4 =+    commonPrefixes +++    "base1:s1 = ( base1:o1 base2:o2 base3:o3 \"l1\" ) .\n"++exoticN3Graph_x5 :: String+exoticN3Graph_x5 =+    commonPrefixes +++    "( base1:o1 base2:o2 base3:o3 \"l1\" ) = base1:s1 .\n"++{-+exoticN3Graph_x6 =+    commonPrefixes +++    " base1:s1 :- (base1:o1 base2:o2 base3:o3 \"l1\") .\n"+-}++--  Formula nodes++exoticN3Graph_x7 :: String+exoticN3Graph_x7 =+    commonPrefixes +++    " { \n" +++    "    base1:s1 base1:p1 base1:o1 .\n" +++    "    base2:s2 base1:p1 base2:o2 .\n" +++    "    base3:s3 base1:p1 base3:o3\n" +++    " }  base2:p2 base2:f2 .\n"++-- as above with the trailing . in the formula+exoticN3Graph_x7a :: String+exoticN3Graph_x7a =+    commonPrefixes +++    " { \n" +++    "    base1:s1 base1:p1 base1:o1 .\n" +++    "    base2:s2 base1:p1 base2:o2 .\n" +++    "    base3:s3 base1:p1 base3:o3 .\n" +++    " }  base2:p2 base2:f2 ."++{-+exoticN3Graph_x8 =+    commonPrefixes +++    " base1:f1 :- \n" +++    " { base1:s1 base1:p1 base1:o1 .     \n" +++    "   base2:s2 base1:p1 base2:o2 .     \n" +++    "   base3:s3 base1:p1 base3:o3 . } ; \n" +++    " base2:p2 base2:f2 . "+-}++{-+exoticN3Graph_x9 =+    commonPrefixes +++    " base1:f1 :- \n" +++    " { base1:s1 base1:p1 base1:o1 . } ; \n" +++    " base2:p2 base2:f2 . "+-}++--  Test allocation of bnodes over a nested formula+exoticN3Graph_x12 :: String+exoticN3Graph_x12 =+    commonPrefixes +++    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" +++    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" +++    "            base2:p2 base2:f2 .                \n" +++    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."++--  List of bnodes+{-+exoticN3Graph_x13 =+    commonPrefixes +++    " base1:s1 :- \n" +++    "  ( [base1:p1 base1:o1] \n" +++    "    [base1:p1 base2:o2] \n" +++    "    [base1:p1 base3:o3] ) .\n"+-}++{-+TODO+Hmm, what does the input graph really mean?++can we test the following somewhere (do we already?)+exoticN3Graph_x13 =+    commonPrefixes +++    " base1:s1 = \n" +++    "  ( [base1:p1 base1:o1] \n" +++    "    [base1:p1 base2:o2] \n" +++    "    [base1:p1 base3:o3] ) .\n"+-}++--  List of more complex bnodes+{-+exoticN3Graph_x14 =+    commonPrefixes +++    " base1:s1 :- \n" +++    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" +++    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" +++    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"+-}+exoticN3Graph_x14 :: String+exoticN3Graph_x14 =+    commonPrefixes +++    " base1:s1 = \n" +++    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" +++    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" +++    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"++--  List with nested list+{-+exoticN3Graph_x15 =+    commonPrefixes +++    " base1:s1 :- \n" +++    "  ( [base1:p1 base1:o1] \n"+++    "    [base2:p2 \n" +++    "       ( [base1:p1 base1:o1] \n" +++    "         [base1:p1 base2:o2] \n" +++    "         [base1:p1 base3:o3] ) ] \n"+++    "    [base1:p1 base3:o3] ) .\n"+-}++--  More complex list with nested list+{-+exoticN3Graph_x16 =+    commonPrefixes +++    " base1:s1 :- \n" +++    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"+++    "    [base2:p2 \n" +++    "       ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" +++    "         [base1:p1 base2:o2; base2:p2 base2:o2] \n" +++    "         [base1:p1 base3:o3; base2:p2 base3:o3] ) ] \n"+++    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"+-}++--  Troublesome example+{-+exoticN3Graph_x17 =+    commonPrefixes +++    "base1:s1 a base1:o1 ; :- \n" +++    "  ( [ base2:p21 base2:o2  ;  \n" +++    "      base2:p22 ( [ base2:p23 \"lx11\" ] \"lx12\" ) ] \n" +++    "    [ base2:p24 base3:o3 ; base2:p25 \"lx13\" ] \n" +++    "  ) . \n"+-}++--  Null prefixes+{-+exoticN3Graph_x18 =+    commonPrefixes +++    "@prefix : <#> . " +++    ":s1 a :o1 ; :- \n" +++    "  ( [ :p21 :o2  ;  \n" +++    "      :p22 ( [ :p23 \"lx11\" ] \"lx12\" ) ] \n" +++    "    [ :p24 :o3 ; :p25 \"lx13\" ] \n" +++    "  ) . \n"+-}++-- Check graph sources parse to expected values++exoticTestSuite :: Test+exoticTestSuite = TestList+  [ parseTest "exoticParseTest01" exoticN3Graph_x1 x1 noError+  , parseTest "exoticParseTest02" exoticN3Graph_x2 x2 noError+    -- exoticParseTest03 = parseTest "exoticParseTest03" exoticN3Graph_x3 x3 noError+  , parseTest "exoticParseTest04" exoticN3Graph_x4 x4 noError+  , parseTest "exoticParseTest05" exoticN3Graph_x5 x5 noError+    -- exoticParseTest06 = parseTest "exoticParseTest06" exoticN3Graph_x6 x6 noError+  , parseTest "exoticParseTest07" exoticN3Graph_x7 x7 noError+  , parseTest "exoticParseTest07a" exoticN3Graph_x7a x7 noError+    -- exoticParseTest08 = parseTest "exoticParseTest08" exoticN3Graph_x8 x8 noError+    -- exoticParseTest09 = parseTest "exoticParseTest09" exoticN3Graph_x9 x9 noError+  , parseTest "exoticParseTest12" exoticN3Graph_x12 x12 noError+    -- exoticParseTest13 = parseTest "exoticParseTest13" exoticN3Graph_x13 x13 noError+    -- exoticParseTest14 = parseTest "exoticParseTest14" exoticN3Graph_x14 x14 noError -- TODO: re-instate?+    -- exoticParseTest15 = parseTest "exoticParseTest15" exoticN3Graph_x15 x15 noError+    -- exoticParseTest16 = parseTest "exoticParseTest16" exoticN3Graph_x16 x16 noError+    -- exoticParseTest17 = parseTest "exoticParseTest17" exoticN3Graph_x17 x17 noError++  , exoticTest "01" x1+  , exoticTest "02" x2+  , exoticTest "03" x3+  , exoticTest "04" x4+  , exoticTest "05" x5+  , exoticTest "06" x6+  , exoticTest "07" x7+    -- exoticTest08 = exoticTest "08" x8 -- TODO: serialisation uses :- with a named node+    -- exoticTest09 = exoticTest "09" x9 -- TODO: serialisation uses :- with a named node+  , testGraphEq  "exoticTest10" False x7 x8+  , testGraphEq  "exoticTest11" False x8 x9+  , exoticTest "12" x12+  , exoticTest "13" x13+  , exoticTest "13a" x13a+  , exoticTest "14" x14+  , exoticTest "15" x15+  , exoticTest "16" x16+  , exoticTest "17" x17++  , fullRoundTripTest "Exotic01" exoticN3Graph_x1+  , fullRoundTripTest "Exotic02" exoticN3Graph_x2+    -- exoticRoundTripTest03 = fullRoundTripTest "Exotic03" exoticN3Graph_x3+  , fullRoundTripTest "Exotic04" exoticN3Graph_x4+  , fullRoundTripTest "Exotic05" exoticN3Graph_x5+    -- exoticRoundTripTest06 = fullRoundTripTest "Exotic06" exoticN3Graph_x6+  , fullRoundTripTest "Exotic07" exoticN3Graph_x7+    -- exoticRoundTripTest08 = fullRoundTripTest "Exotic08" exoticN3Graph_x8+    -- exoticRoundTripTest09 = fullRoundTripTest "Exotic09" exoticN3Graph_x9+  , fullRoundTripTest "Exotic12" exoticN3Graph_x12+  , fullRoundTripTest "Exotic14" exoticN3Graph_x14+    -- exoticRoundTripTest15 = fullRoundTripTest "Exotic15" exoticN3Graph_x15+    -- exoticRoundTripTest16 = fullRoundTripTest "Exotic16" exoticN3Graph_x16+    -- exoticRoundTripTest17 = fullRoundTripTest "Exotic17" exoticN3Graph_x17+    -- exoticRoundTripTest18 = fullRoundTripTest "Exotic18" exoticN3Graph_x18+    +  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ trivialTestSuite+  , parseTestSuite+  , roundTripTestSuite+  , simpleTestSuite+  , exoticTestSuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/N3ParserTest.hs view
@@ -0,0 +1,1434 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  N3ParserTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module contains test cases for module "N3Parser".+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.N3Parser+    ( parseN3fromString, parseN3+    , parseTextFromString, parseAltFromString+    , parseNameFromString, parsePrefixFromString+    , parseAbsURIrefFromString, parseLexURIrefFromString+    , parseURIref2FromString+    )++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..), NSGraph(..)+    -- LookupNamespace(..), Namespace+    , emptyNamespaceMap+    , LookupFormula(..), emptyFormulaMap+    , emptyRDFGraph, toRDFGraph+      -- Export selected RDFLabel values+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil+    , res_owl_sameAs, res_log_implies+    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , nullNamespace+    , ScopedName(..)+    , makeScopedName+    , nullScopedName+    , makeUriScopedName+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , langName+    , rdf_XMLLiteral+    )++import Swish.Utils.QName (QName, qnameFromURI)+import Swish.Utils.LookupMap (LookupMap(..))++import Swish.RDF.GraphClass (Arc, arc) ++import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT)++import Data.List (intercalate)++------------------------------------------------------------+--  Generic item parsing test wrapper+------------------------------------------------------------++type ParseFromString a = String -> (Either String a)++parseItemTest :: (Eq a, Show a) => ParseFromString a -> a+                 -> String -> String -> a -> String -> Test+parseItemTest ifroms def lab inp val err =+    TestList+      [ TestCase ( assertEqual ("parseItemError:"++lab) fixerr pe )+      , TestCase ( assertEqual ("parseItemValue:"++lab) val pv )+      ]+    where+        (pe,pv) = case ifroms inp of+            Left  e -> (e,def)+            Right v -> (noError,v)+        fixerr = if err /= noError then pe else noError++noError, errorText :: String+noError   = ""+errorText = "*"++------------------------------------------------------------+--  Common test wrappers+------------------------------------------------------------++testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test+testLabelEq lab eq n1 n2 =+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )++testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test+testGraphEq lab eq gg1 gg2 =+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )++parseTest :: String -> String -> RDFGraph -> String -> Test+parseTest lab inp gr er =+    TestList+      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )+      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )+      ]+    where+        (pe,pg) = case parseN3fromString inp of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++parseTestB :: QName -> String -> String -> RDFGraph -> String -> Test+parseTestB base lab inp gr er =+    TestList+      [ TestCase ( assertEqual ("parseTestError<base>:"++lab) er pe )+      , TestCase ( assertEqual ("parseTestGraph<base>:"++lab) gr pg )+      ]+    where+        (pe,pg) = case parseN3 inp (Just base) of+            Right g -> ("",g)+            Left  s -> (s,emptyRDFGraph)++------------------------------------------------------------+--  Test simple character parsing+------------------------------------------------------------++parseCharTest :: String -> String+                 -> String -> String -> String -> Test+parseCharTest c = parseItemTest (parseTextFromString c) ""++parseAltTest :: String -> String+                -> String -> String -> String -> String -> Test+parseAltTest cc1 cc2 = parseItemTest (parseAltFromString cc1 cc2) ""++charInp01, char01 :: String+charInp01 = ":"+char01    = ":"++charInp02, char02 :: String+charInp02 = "<>"+char02    = "<>"++charInp03 :: String+charInp03 = "<="++charTestSuite :: Test+charTestSuite = TestList+  [ parseCharTest char01 "parseCharTest01" charInp01 char01 noError+  , parseCharTest char02 "parseCharTest02" charInp02 char02 noError+  , parseAltTest char01 char02 "parseCharTest03" charInp01 char01 noError+  , parseAltTest char01 char02 "parseCharTest04" charInp02 char02 noError+  , parseAltTest char01 char02 "parseCharTest04" charInp03 "" errorText+  ]++------------------------------------------------------------+--  Test simple name parsing+------------------------------------------------------------++parseNameTest :: String -> String -> String -> String -> Test+parseNameTest = parseItemTest parseNameFromString ""++nameTestSuite :: Test+nameTestSuite = TestList+  [ parseNameTest "parseNameTest01" "name" "name" ""+  , parseNameTest "parseNameTest02" "rdf" "rdf" ""+  ]++------------------------------------------------------------+--  Test simple prefix parsing+------------------------------------------------------------++parsePrefixTest :: String -> String -> Namespace -> String -> Test+parsePrefixTest = parseItemTest parsePrefixFromString nullNamespace++prefix01, prefix02 :: Namespace+prefix01 = Namespace "pref" "pref:"+prefix02 = Namespace "rdf" $ nsURI namespaceRDF++prefixTestSuite :: Test+prefixTestSuite = TestList+  [ parsePrefixTest "parsePrefixTest01" "pref" prefix01 ""+  , parsePrefixTest "parsePrefixTest02" "rdf" prefix02 ""+  ]++------------------------------------------------------------+--  Test absolute URIref parsing+------------------------------------------------------------++parseAbsUriRefTest :: String -> String -> String -> String -> Test+parseAbsUriRefTest = parseItemTest parseAbsURIrefFromString ""++parseLexUriRefTest :: String -> String -> String -> String -> Test+parseLexUriRefTest = parseItemTest parseLexURIrefFromString ""++absUriRefInp01, absUriRefInp01s, absUriRef01 :: String+absUriRefInp01  = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>"+absUriRefInp01s = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type> "+absUriRef01     = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"++absUriRefInp02, absUriRefInp02s, absUriRef02 :: String+absUriRefInp02  = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"+absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "+absUriRef02     = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"++absUriRefTestSuite :: Test+absUriRefTestSuite = TestList+  [ parseAbsUriRefTest "parseAbsUriRefTest01" absUriRefInp01 absUriRef01 ""+  , parseAbsUriRefTest "parseAbsUriRefTest02" absUriRefInp02 absUriRef02 ""+  , parseLexUriRefTest "parseAbsUriRefTest03" absUriRefInp01s absUriRef01 ""+  , parseLexUriRefTest "parseAbsUriRefTest04" absUriRefInp02s absUriRef02 ""+  ]++------------------------------------------------------------+--  Test simple URIref parsing+------------------------------------------------------------++parseUriRef2Test :: String -> String -> ScopedName -> String -> Test+parseUriRef2Test = parseItemTest parseURIref2FromString nullScopedName++uriRef01 :: String+uriRef01 = "rdf:type "++sname01 :: ScopedName+sname01  = ScopedName namespaceRDF "type"++uriRef02 :: String+uriRef02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "++sname02 :: ScopedName+sname02  =+    makeScopedName "" "http://id.ninebynine.org/wip/2003/test/graph1/node#" "s1"++uriRef2TestSuite :: Test+uriRef2TestSuite = TestList+  [ parseUriRef2Test "parseUriRef2Test01" uriRef01 sname01 ""+  , parseUriRef2Test "parseUriRef2Test02" uriRef02 sname02 ""+  ]++------------------------------------------------------------+--  Define some common values+------------------------------------------------------------++baseFile :: String+baseFile = "file:///dev/null"++dqn :: QName+dqn = qnameFromURI baseFile++dbase, base1, base2, base3, base4, basea :: Namespace+dbase = Namespace ""      (baseFile ++ "#")+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node/"+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node#"+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"+basea = Namespace "a" "http://example.org/basea#"++u1 :: RDFLabel+u1 = Res $ ScopedName base1 ""++ds1, ds2, ds3 :: RDFLabel+ds1 = Res $ ScopedName dbase "s1"+ds2 = Res $ ScopedName dbase "s2"+ds3 = Res $ ScopedName dbase "s3"++dp1, dp2, dp3 :: RDFLabel+dp1 = Res $ ScopedName dbase "p1"+dp2 = Res $ ScopedName dbase "p2"+dp3 = Res $ ScopedName dbase "p3"++do1, do2, do3 :: RDFLabel+do1 = Res $ ScopedName dbase "o1"+do2 = Res $ ScopedName dbase "o2"+do3 = Res $ ScopedName dbase "o3"++s1, s2, s3, sa :: RDFLabel+s1 = Res $ ScopedName base1 "s1"+s2 = Res $ ScopedName base2 "s2"+s3 = Res $ ScopedName base3 "s3"+sa = Res $ ScopedName basea "a"++b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel+b1 = Blank "b1"+b2 = Blank "b2"+b3 = Blank "b3"+b4 = Blank "b4"+b5 = Blank "b5"+b6 = Blank "b6"+b7 = Blank "b7"+b8 = Blank "b8"++c1, c2, c3, c4, c5, c6 :: RDFLabel+c1 = Blank "c1"+c2 = Blank "c2"+c3 = Blank "c3"+c4 = Blank "c4"+c5 = Blank "c5"+c6 = Blank "c6"++p1, p2, p3, pa :: RDFLabel+p1 = Res $ ScopedName base1 "p1" +p2 = Res $ ScopedName base2 "p2" +p3 = Res $ ScopedName base3 "p3" +pa = Res $ ScopedName basea "b" ++o1, o2, o3, oa :: RDFLabel+o1 = Res $ ScopedName base1 "o1"+o2 = Res $ ScopedName base2 "o2"+o3 = Res $ ScopedName base3 "o3"+oa = Res $ ScopedName basea "c"++l1, l2, l3 :: RDFLabel+l1 = Lit "l1"  Nothing+l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing+l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing++lfr, lxml, lfrxml :: RDFLabel+lfr    = Lit "chat"          (Just $ langName "fr")+lxml   = Lit "<br/>"         (Just rdf_XMLLiteral )+lfrxml = Lit "<em>chat</em>" (Just rdf_XMLLiteral )++bTrue, bFalse :: RDFLabel+bTrue  = Lit "true"  $ Just $ ScopedName (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") "boolean"+bFalse = Lit "false" $ Just $ ScopedName (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") "boolean"++f1, f2 :: RDFLabel+f1 = Res $ ScopedName base1 "f1"+f2 = Res $ ScopedName base2 "f2" ++v1, v2, v3, v4 :: RDFLabel+v1 = Var "var1"+v2 = Var "var2"+v3 = Var "var3"+v4 = Var "var4"++------------------------------------------------------------+--  Construct graphs for testing+------------------------------------------------------------++t01 , t01b, t02, t03, t04, t05, t06, t07 :: Arc RDFLabel+t01  = arc s1 p1 o1+t01b = arc b1 b2 b3+t02  = arc s2 p1 o2+t03  = arc s3 p1 o3+t04  = arc s1 p1 l1+t05  = arc s2 p1 b1+t06  = arc s3 p1 l2+t07  = arc s3 p2 l3++makeNewPrefixNamespace :: (String,Namespace) -> Namespace+makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)++dg1 :: RDFGraph+dg1 = toRDFGraph [arc ds1 dp1 do1]++dg2 :: RDFGraph+dg2 = toRDFGraph+      [ arc xa1 xb1 xc1+      , arc xa2 xb2 xc2+      , arc xa3 xb3 xc3+      , arc xa4 xb4 xc4+      , arc xa5 xb5 xc5+      ]+  where+    -- the document base is set to file:///dev/null to begin with+    mU = Res . makeUriScopedName +    xa1 = mU "file:///dev/a1"+    xb1 = mU "file:///dev/b1"+    xc1 = mU "file:///dev/c1"+    xa2 = mU "http://example.org/ns/a2"+    xb2 = mU "http://example.org/ns/b2"+    xc2 = mU "http://example.org/ns/c2"+    xa3 = mU "http://example.org/ns/foo/a3"+    xb3 = mU "http://example.org/ns/foo/b3"+    xc3 = mU "http://example.org/ns/foo/c3"+    +    ns4 = Namespace "" "http://example.org/ns/foo/bar#"+    ns5 = Namespace "" "http://example.org/ns2#"+    mUN a b = Res (ScopedName a b)+    xa4 = mUN ns4 "a4"+    xb4 = mUN ns4 "b4"+    xc4 = mUN ns4 "c4"+    xa5 = mUN ns5 "a5"+    xb5 = mUN ns5 "b5"+    xc5 = mUN ns5 "c5"++nslist :: LookupMap Namespace+nslist = LookupMap $ map makeNewPrefixNamespace+    [ ("base1",base1)+    , ("base2",base2)+    , ("base3",base3)+    , ("base4",base4)+    ]++toGraph :: [Arc RDFLabel] -> RDFGraph+toGraph stmts = NSGraph { namespaces = nslist+                        , formulae   = emptyFormulaMap+                        , statements = stmts+                        }++g1 :: RDFGraph+g1 = toGraph [t01]++g1a :: RDFGraph+g1a = toGraph [arc sa pa oa] ++g1_31 :: RDFGraph+g1_31 = toGraph [arc u1 u1 u1]++g1b :: RDFGraph+g1b = toGraph [t01b]++g2 :: RDFGraph+g2 = toGraph [t01,t02,t03]++g3 :: RDFGraph+g3 = toGraph [t01,t04]++g4 :: RDFGraph+g4 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t01,t05]+        }++g5 :: RDFGraph+g5 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t01,t02,t03,t04,t05]+        }++g6 :: RDFGraph+g6 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t01,t06]+        }++g7 :: RDFGraph+g7 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t01,t07]+        }++t801, t802, t807, t808, t811, t812 :: Arc RDFLabel+t801 = arc s1 res_rdf_type       o1+t802 = arc s2 res_owl_sameAs     o2+t807 = arc o1 p1 s1+t808 = arc s2 p1 o2+t811 = arc s1 res_log_implies o1+t812 = arc o2 res_log_implies s2++g8 :: RDFGraph+g8 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t801,t802,t807,t808,t811,t812]+        }++g81 :: RDFGraph+g81 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t801,t802]+        }++g83 :: RDFGraph+g83 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t807,t808,t811,t812]+        }++t911, t912, t913, t914, t921, t922, t923, t924,+  t925, t926, t927, t928 :: Arc RDFLabel+t911 = arc s1 p1 o1+t912 = arc s1 p1 o2+t913 = arc s1 p2 o2+t914 = arc s1 p2 o3+t921 = arc s2 p1 o1+t922 = arc s2 p1 o2+t923 = arc s2 p1 o3+t924 = arc s2 p1 l1+t925 = arc s2 p2 o1+t926 = arc s2 p2 o2+t927 = arc s2 p2 o3+t928 = arc s2 p2 l1++g9 :: RDFGraph+g9 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t911,t912,t913,t914,+                        t921,t922,t923,t924,+                        t925,t926,t927,t928]+        }++t1011, t1012, t1013, t1014, t1021, t1022, t1023, t1024,+  t1025, t1026, t1027, t1028 :: Arc RDFLabel+t1011 = arc s1 p1 o1+t1012 = arc o2 p1 s1+t1013 = arc s1 p2 o2+t1014 = arc o3 p2 s1+t1021 = arc s2 p1 o1+t1022 = arc s2 p1 o2+t1023 = arc s2 p1 o3+t1024 = arc s2 p1 l1+t1025 = arc o1 p2 s2+t1026 = arc o2 p2 s2+t1027 = arc o3 p2 s2+t1028 = arc l1 p2 s2++g10 :: RDFGraph+g10 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t1011,t1012,t1013,t1014,+                        t1021,t1022,t1023,t1024,+                        t1025,t1026,t1027,t1028]+        }++t1111, t1112, t1113 :: Arc RDFLabel+t1111 = arc s1 p1 v1+t1112 = arc v2 p1 o1+t1113 = arc v3 p1 v4++g11 :: RDFGraph+g11 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t1111,t1112,t1113]+        }++t1211, t1221, t1222, t1223, t1224 :: Arc RDFLabel+t1211 = arc b1 p1 o1+t1221 = arc b2 res_rdf_first v1+t1222 = arc b2 res_rdf_rest  b3+t1223 = arc b3 res_rdf_first v2+t1224 = arc b3 res_rdf_rest  res_rdf_nil++g12 :: RDFGraph+g12 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t1211,t1221,t1222,t1223,t1224]+        }++t1711, t1722, t1733 :: Arc RDFLabel+t1711 = arc s1 p1 lfr+t1722 = arc s2 p2 lxml+t1733 = arc s3 p3 lfrxml++g17 :: RDFGraph+g17 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [t1711,t1722,t1733]+        }++tx101, tx102, tx111, tx112, tx113, tx114, tx121, tx122, tx123,+  tx124, tx125, tx126, tx127, tx128 :: Arc RDFLabel+tx101 = arc b1 res_owl_sameAs s1+tx102 = arc s2 res_owl_sameAs b2+tx111 = arc b1 p1 o1+tx112 = arc b1 p1 o2+tx113 = arc b1 p2 o2+tx114 = arc b1 p2 o3+tx121 = arc b2 p1 o1+tx122 = arc b2 p1 o2+tx123 = arc b2 p1 o3+tx124 = arc b2 p1 l1+tx125 = arc b2 p2 o1+tx126 = arc b2 p2 o2+tx127 = arc b2 p2 o3+tx128 = arc b2 p2 l1++x1 :: RDFGraph+x1 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx101,tx102,+                        tx111,tx112,tx113,tx114,+                        tx121,tx122,tx123,tx124,+                        tx125,tx126,tx127,tx128]+        }++tx201, tx202, tx211, tx212, tx213, tx214, tx221, tx222, tx223,+  tx224, tx225, tx226, tx227, tx228 :: Arc RDFLabel+tx201 = arc b1 res_owl_sameAs s1+tx202 = arc s2 res_owl_sameAs b2+tx211 = arc b1 p1 o1+tx212 = arc o2 p1 b1+tx213 = arc b1 p2 o2+tx214 = arc o3 p2 b1+tx221 = arc b2 p1 o1+tx222 = arc b2 p1 o2+tx223 = arc b2 p1 o3+tx224 = arc b2 p1 l1+tx225 = arc o1 p2 b2+tx226 = arc o2 p2 b2+tx227 = arc o3 p2 b2+tx228 = arc l1 p2 b2++x2 :: RDFGraph+x2 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx201,tx202,+                        tx211,tx212,tx213,tx214,+                        tx221,tx222,tx223,tx224,+                        tx225,tx226,tx227,tx228]+        }++tx311, tx312, tx313, tx314, tx321, tx322, tx323,+  tx324, tx325, tx326, tx327, tx328 :: Arc RDFLabel+tx311 = arc s1 p1 o1+tx312 = arc o2 p1 s1+tx313 = arc s1 p2 o2+tx314 = arc o3 p2 s1+tx321 = arc s2 p1 o1+tx322 = arc s2 p1 o2+tx323 = arc s2 p1 o3+tx324 = arc s2 p1 l1+tx325 = arc o1 p2 s2+tx326 = arc o2 p2 s2+tx327 = arc o3 p2 s2+tx328 = arc l1 p2 s2++x3 :: RDFGraph+x3 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx311,tx312,tx313,tx314,+                        tx321,tx322,tx323,tx324,+                        tx325,tx326,tx327,tx328]+        }++tx401, tx402, tx403, tx404, tx405, tx406, tx407,+  tx408, tx409 :: Arc RDFLabel+tx401 = arc s1 res_owl_sameAs b1+tx402 = arc b1 res_rdf_first  o1+tx403 = arc b1 res_rdf_rest   b2+tx404 = arc b2 res_rdf_first  o2+tx405 = arc b2 res_rdf_rest   b3+tx406 = arc b3 res_rdf_first  o3+tx407 = arc b3 res_rdf_rest   b4+tx408 = arc b4 res_rdf_first  l1+tx409 = arc b4 res_rdf_rest   res_rdf_nil++x4 :: RDFGraph+x4 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx401,tx402,tx403,tx404,+                        tx405,tx406,tx407,tx408,+                        tx409]+        }++tx501, tx502, tx503, tx504, tx505, tx506, tx507,+  tx508, tx509 :: Arc RDFLabel+tx501 = arc b1 res_owl_sameAs s1+tx502 = arc b1 res_rdf_first  o1+tx503 = arc b1 res_rdf_rest   b2+tx504 = arc b2 res_rdf_first  o2+tx505 = arc b2 res_rdf_rest   b3+tx506 = arc b3 res_rdf_first  o3+tx507 = arc b3 res_rdf_rest   b4+tx508 = arc b4 res_rdf_first  l1+tx509 = arc b4 res_rdf_rest   res_rdf_nil++x5 :: RDFGraph+x5 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx501,tx502,tx503,tx504,+                        tx505,tx506,tx507,tx508,+                        tx509]+        }++tx601, tx602, tx603, tx604, tx605, tx606, tx607,+  tx608 :: Arc RDFLabel+tx601 = arc s1 res_rdf_first o1+tx602 = arc s1 res_rdf_rest  b2+tx603 = arc b2 res_rdf_first o2+tx604 = arc b2 res_rdf_rest  b3+tx605 = arc b3 res_rdf_first o3+tx606 = arc b3 res_rdf_rest  b4+tx607 = arc b4 res_rdf_first l1+tx608 = arc b4 res_rdf_rest  res_rdf_nil++x6 :: RDFGraph+x6 = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx601,tx602,tx603,tx604,+                        tx605,tx606,tx607,tx608]+        }++tx701 :: Arc RDFLabel+tx701 = arc b1 p2 f2++x7 :: RDFGraph+x7    = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 g2]+        , statements = [tx701]+        }++tx801 :: Arc RDFLabel+tx801 = arc f1 p2 f2++x8 :: RDFGraph+x8    = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula f1 g2]+        , statements = [tx801]+        }++x9 :: RDFGraph+x9    = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula f1 g1]+        , statements = [tx801]+        }++--  Test allocation of bnodes carries over a nested formula++tx1201, tx1202, tx1203, tx1204, tx1205, +  tx1211, tx1212 :: Arc RDFLabel+tx1201 = arc s1 p1 b1+tx1202 = arc b1 p1 o1+tx1203 = arc b2 p2 f2+tx1204 = arc s3 p3 b3+tx1205 = arc b3 p3 o3+tx1211 = arc s2 p2 b4+tx1212 = arc b4 p2 o2++x12fg :: RDFGraph+x12fg  = NSGraph+        { namespaces = emptyNamespaceMap+        , formulae   = emptyFormulaMap+        , statements = [tx1211,tx1212]+        }+        +x12 :: RDFGraph+x12    = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b2 x12fg]+        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]+        }++--  List of simple anon nodes++tx1301, tx1302, tx1303, tx1304, tx1305, tx1306, tx1307,+  tx1308, tx1309 :: Arc RDFLabel+tx1301 = arc s1 res_rdf_first b1+tx1302 = arc s1 res_rdf_rest  c1+tx1303 = arc c1 res_rdf_first b2+tx1304 = arc c1 res_rdf_rest  c2+tx1305 = arc c2 res_rdf_first b3+tx1306 = arc c2 res_rdf_rest  res_rdf_nil+tx1307 = arc b1 p1 o1+tx1308 = arc b2 p1 o2+tx1309 = arc b3 p1 o3++x13 :: RDFGraph+x13    = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,+                        tx1307,tx1308,tx1309]+        }++--  List of more complex anon nodes++tx1401, tx1402, tx1403, tx1404, tx1405, tx1406, tx1407,+  tx1408, tx1409, tx1410, tx1411, tx1412 :: Arc RDFLabel+tx1401 = arc s1 res_rdf_first b1+tx1402 = arc s1 res_rdf_rest  c1+tx1403 = arc c1 res_rdf_first b2+tx1404 = arc c1 res_rdf_rest  c2+tx1405 = arc c2 res_rdf_first b3+tx1406 = arc c2 res_rdf_rest  res_rdf_nil+tx1407 = arc b1 p1 o1+tx1408 = arc b1 p2 o1+tx1409 = arc b2 p1 o2+tx1410 = arc b2 p2 o2+tx1411 = arc b3 p1 o3+tx1412 = arc b3 p2 o3++x14 :: RDFGraph+x14    = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,+                        tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]+        }++--  List with nested list++tx1501, tx1502, tx1503, tx1504, tx1505, tx1506, tx1507,+  tx1508, tx1509 :: Arc RDFLabel+tx1501 = arc s1 res_rdf_first b1+tx1502 = arc s1 res_rdf_rest  c1+tx1503 = arc c1 res_rdf_first b2+tx1504 = arc c1 res_rdf_rest  c2+tx1505 = arc c2 res_rdf_first b3+tx1506 = arc c2 res_rdf_rest  res_rdf_nil+tx1507 = arc b1 p1 o1+tx1508 = arc b2 p2 c3+tx1509 = arc b3 p1 o3++tx1521, tx1522, tx1523, tx1524, tx1525, tx1526, tx1527,+  tx1528, tx1529 :: Arc RDFLabel+tx1521 = arc c3 res_rdf_first b4+tx1522 = arc c3 res_rdf_rest  c4+tx1523 = arc c4 res_rdf_first b5+tx1524 = arc c4 res_rdf_rest  c5+tx1525 = arc c5 res_rdf_first b6+tx1526 = arc c5 res_rdf_rest  res_rdf_nil+tx1527 = arc b4 p1 o1+tx1528 = arc b5 p1 o2+tx1529 = arc b6 p1 o3++x15 :: RDFGraph+x15    = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,+                        tx1507,tx1508,tx1509,+                        tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,+                        tx1527,tx1528,tx1529]+        }++--  More complex list with nested list++tx1601, tx1602, tx1603, tx1604, tx1605, tx1606, tx1607,+  tx1608, tx1609, tx1610, tx1611 :: Arc RDFLabel+tx1601 = arc s1 res_rdf_first b1+tx1602 = arc s1 res_rdf_rest  c1+tx1603 = arc c1 res_rdf_first b2+tx1604 = arc c1 res_rdf_rest  c2+tx1605 = arc c2 res_rdf_first b3+tx1606 = arc c2 res_rdf_rest  res_rdf_nil+tx1607 = arc b1 p1 o1+tx1608 = arc b1 p2 o1+tx1609 = arc b2 p2 c3+tx1610 = arc b3 p1 o3+tx1611 = arc b3 p2 o3++tx1621, tx1622, tx1623, tx1624, tx1625, tx1626, tx1627,+  tx1628, tx1629, tx1630, tx1631, tx1632 :: Arc RDFLabel+tx1621 = arc c3 res_rdf_first b4+tx1622 = arc c3 res_rdf_rest  c4+tx1623 = arc c4 res_rdf_first b5+tx1624 = arc c4 res_rdf_rest  c5+tx1625 = arc c5 res_rdf_first b6+tx1626 = arc c5 res_rdf_rest  res_rdf_nil+tx1627 = arc b4 p1 o1+tx1628 = arc b4 p2 o1+tx1629 = arc b5 p1 o2+tx1630 = arc b5 p2 o2+tx1631 = arc b6 p1 o3+tx1632 = arc b6 p2 o3++x16 :: RDFGraph+x16    = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,+                        tx1607,tx1608,tx1609,tx1610,tx1611,+                        tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,+                        tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]+        }++kg1 :: RDFGraph+kg1 = toRDFGraph+      [ arc b a c ]+  where+    -- the document base is set to file:///dev/null to begin with+    ns = Namespace "" (baseFile ++ "#")+    mUN = Res . ScopedName ns+    a = mUN "a"+    b = mUN "b"+    c = mUN "c"++------------------------------------------------------------+--  Simple parser tests+------------------------------------------------------------++-- check default base+simpleN3Graph_dg_01 :: String+simpleN3Graph_dg_01 =+    ":s1 :p1 :o1 ."++-- from the turtle documentation+simpleN3Graph_dg_02 :: String+simpleN3Graph_dg_02 =+  "# this is a complete turtle document\n" +++  "# In-scope base URI is the document URI at this point\n" +++  "<a1> <b1> <c1> .\n" +++  "@base <http://example.org/ns/> .\n" +++  "# In-scope base URI is http://example.org/ns/ at this point\n" +++  "<a2> <http://example.org/ns/b2> <c2> .\n" +++  "@base <foo/> .\n" +++  "# In-scope base URI is http://example.org/ns/foo/ at this point\n" +++  "<a3> <b3> <c3> .\n" +++  "@prefix : <bar#> .\n" +++  ":a4 :b4 :c4 .\n" +++  "@prefix : <http://example.org/ns2#> .\n" +++  ":a5 :b5 :c5 .\n"++commonPrefixes :: String+commonPrefixes =+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" +++    "@prefix base2 : <" ++ nsURI base2 ++ "> . \n" +++    "@prefix base3 : <" ++ nsURI base3 ++ "> . \n"++--  Single statement using <uri> form+simpleN3Graph_g1_01 :: String+simpleN3Graph_g1_01 =+    " <http://id.ninebynine.org/wip/2003/test/graph1/node/s1> " +++    " <http://id.ninebynine.org/wip/2003/test/graph1/node/p1> " +++    " <http://id.ninebynine.org/wip/2003/test/graph1/node/o1> . "++--  Single statement using prefix:name form+simpleN3Graph_g1_02 :: String+simpleN3Graph_g1_02 =+    "@prefix base1 : <" ++ nsURI base1 ++ "> ." +++    " base1:s1 base1:p1 base1:o1 . "++--  Single statement using prefix:name form+--  (this was added to check that the parser did not+--   think we meant 'a:a a :b .' here)+--+simpleN3Graph_g1_02a :: String+simpleN3Graph_g1_02a =+    "@prefix a: <" ++ nsURI basea ++ "> ." +++    "a:a a:b a:c ."++--  Single statement using :name form+simpleN3Graph_g1_03 :: String+simpleN3Graph_g1_03 =+    "@prefix : <" ++ nsURI base1 ++ "> .\n" +++    " :s1 :p1 :o1 . "++--  Turtle supports ':' but (apparently) not N3, but try+--  and support it.+--+simpleN3Graph_g1_03_1 :: String+simpleN3Graph_g1_03_1 =+    "@prefix : <" ++ nsURI base1 ++ "> .\n" +++    " : : :."++simpleN3Graph_g1_03_2 :: String+simpleN3Graph_g1_03_2 =+    "@prefix b: <" ++ nsURI base1 ++ "> .\n" +++    "b: b: b:. "++--  Single statement using relative URI form+simpleN3Graph_g1_04 :: String+simpleN3Graph_g1_04 =+    "@base <" ++ nsURI base1 ++ "> .\n" +++    " <s1> <p1> <o1> . "++--  Single statement using blank nodes+simpleN3Graph_g1_05 :: String+simpleN3Graph_g1_05 =+    "@base <" ++ nsURI base1 ++ "> .\n" +++    " _:b1 _:b2 _:b3 . "++--  Single statement with junk following+simpleN3Graph_g1_06 :: String+simpleN3Graph_g1_06 =+    "@prefix base1 : <" ++ nsURI base1 ++ "> ." +++    " base1:s1 base1:p1 base1:o1 . " +++    " **** "++--  Multiple statements+simpleN3Graph_g2 :: String+simpleN3Graph_g2 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base2:s2 base1:p1 base2:o2 . \n" +++    " base3:s3 base1:p1 base3:o3 . \n"++--  Graph with literal+simpleN3Graph_g3 :: String+simpleN3Graph_g3 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base1:s1 base1:p1 \"l1\" . \n"++--  Graph with nodeid+simpleN3Graph_g4 :: String+simpleN3Graph_g4 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base2:s2 base1:p1 _:b1 . \n"++--  Graph with literal and nodeid+simpleN3Graph_g5 :: String+simpleN3Graph_g5 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base2:s2 base1:p1 base2:o2 . \n" +++    " base3:s3 base1:p1 base3:o3 . \n" +++    " base1:s1 base1:p1 \"l1\" . \n"   +++    " base2:s2 base1:p1 _:b1 . \n"++--  Triple-quoted literal+simpleN3Graph_g6 :: String+simpleN3Graph_g6 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base3:s3 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" . \n"++--  String escapes+simpleN3Graph_g7 :: String+simpleN3Graph_g7 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 . \n" +++    " base3:s3 base2:p2 " +++    " \"l3--\\r\\\"\\'\\\\--\\u0020--\\U000000A0--\" " +++    " . \n"++--  Different verb forms+simpleN3Graph_g8 :: String+simpleN3Graph_g8 =+    commonPrefixes +++    " base1:s1 a base1:o1 . \n" +++    " base2:s2 = base2:o2 . \n" +++    " base1:s1 @is  base1:p1 @of base1:o1 . \n" +++    " base2:s2 @has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++simpleN3Graph_g8b :: String+simpleN3Graph_g8b =+    commonPrefixes +++    " base1:s1 a base1:o1 . \n" +++    " base2:s2 = base2:o2 . \n" +++    " base1:s1 is  base1:p1 of base1:o1 . \n" +++    " base2:s2 @has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++simpleN3Graph_g81 :: String+simpleN3Graph_g81 =+    commonPrefixes +++    " base1:s1 a base1:o1 . \n" +++    " base2:s2 = base2:o2 . \n"++simpleN3Graph_g83 :: String+simpleN3Graph_g83 =+    commonPrefixes +++    " base1:s1 @is  base1:p1 @of base1:o1 . \n" +++    " base2:s2 @has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++simpleN3Graph_g83b :: String+simpleN3Graph_g83b =+    commonPrefixes +++    " base1:s1 is  base1:p1 of base1:o1 . \n" +++    " base2:s2 @has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++--  Semicolons and commas+simpleN3Graph_g9 :: String+simpleN3Graph_g9 =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 ; \n" +++    "          base1:p1 base2:o2 ; \n" +++    "          base2:p2 base2:o2 ; \n" +++    "          base2:p2 base3:o3 . \n" +++    " base2:s2 base1:p1 base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 , \n" +++    "                   \"l1\"   ; \n" +++    "          base2:p2 base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 , \n" +++    "                   \"l1\"   . \n"++-- ensure you can end a property list with a semicolon+simpleN3Graph_g9b :: String+simpleN3Graph_g9b =+    commonPrefixes +++    " base1:s1 base1:p1 base1:o1 ; \n" +++    "          base1:p1 base2:o2 ; \n" +++    "          base2:p2 base2:o2 ; \n" +++    "          base2:p2 base3:o3;. \n" +++    " base2:s2 base1:p1 base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 , \n" +++    "                   \"l1\"   ; \n" +++    "          base2:p2 base1:o1 , \n" +++    "                   base2:o2 , \n" +++    "                   base3:o3 , \n" +++    "                   \"l1\"   ;. \n"++--  'is ... of' and semicolons and commas+simpleN3Graph_g10 :: String+simpleN3Graph_g10 =+    commonPrefixes +++    " base1:s1 @has base1:p1 base1:o1 ; \n" +++    "          @is  base1:p1 @of base2:o2 ; \n" +++    "          @has base2:p2 base2:o2 ; \n" +++    "          @is  base2:p2 @of base3:o3 . \n" +++    " base2:s2 @has base1:p1 base1:o1 , \n" +++    "                        base2:o2 , \n" +++    "                        base3:o3 , \n" +++    "                        \"l1\"   ; \n" +++    "          @is  base2:p2 @of base1:o1 , \n" +++    "                          base2:o2 , \n" +++    "                          base3:o3 , \n" +++    "                          \"l1\"   . \n"++--  Simple statements using ?var form+simpleN3Graph_g11 :: String+simpleN3Graph_g11 =+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" +++    " base1:s1 base1:p1 ?var1 . \n"          +++    " ?var2 base1:p1 base1:o1 . \n"          +++    " ?var3 base1:p1 ?var4 .    \n"++--  Bare anonymous nodes+simpleN3Graph_g12 :: String+simpleN3Graph_g12 =+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" +++    " [ base1:p1 base1:o1 ] .  \n"          +++    " ( ?var1 ?var2 ) .    \n"++--  Literals with dataype and language+simpleN3Graph_g17 :: String+simpleN3Graph_g17 =+    commonPrefixes +++    " base1:s1 base1:p1 \"chat\"@fr . \n "                          +++    " base2:s2 base2:p2 \"<br/>\"^^rdf:XMLLiteral . \n "            +++    " base3:s3 base3:p3 \"<em>chat</em>\"^^rdf:XMLLiteral . \n "++emsg16 :: String+emsg16 = intercalate "\n" [+  "",+  "@prefix base1 : <http://id.ninebynine.org/wip/2003/test/graph1/node/> . base1:s1 base1:p1 base1:o1 .  **** ",+  "                                                                                                      ^",+  "(line 1, column 103 indicated by the '^' sign above):",+  "",+  "unexpected \"*\"",+  "expecting declaration, \"@\", pathitem or end of input"+  ]+++simpleTestSuite :: Test+simpleTestSuite = TestList+  [ parseTestB dqn "simpleTestd01" simpleN3Graph_dg_01 dg1  noError+  , parseTestB dqn "simpleTestd02" simpleN3Graph_dg_02 dg2  noError+  , parseTest "simpleTest011" simpleN3Graph_g1_01 g1  noError+  , parseTest "simpleTest012" simpleN3Graph_g1_02 g1  noError+  , parseTest "simpleTest012a" simpleN3Graph_g1_02a g1a  noError+  , parseTest "simpleTest013" simpleN3Graph_g1_03 g1  noError+  , parseTest "simpleTest013_1" simpleN3Graph_g1_03_1 g1_31  noError+  , parseTest "simpleTest013_2" simpleN3Graph_g1_03_2 g1_31  noError+  , parseTest "simpleTest014" simpleN3Graph_g1_04 g1  noError+  , parseTest "simpleTest015" simpleN3Graph_g1_05 g1b noError+  , parseTest "simpleTest016" simpleN3Graph_g1_06 emptyRDFGraph emsg16+  , parseTest "simpleTest03"  simpleN3Graph_g2    g2  noError+  , parseTest "simpleTest04"  simpleN3Graph_g3    g3  noError+  , parseTest "simpleTest05"  simpleN3Graph_g4    g4  noError+  , parseTest "simpleTest06"  simpleN3Graph_g5    g5  noError+  , parseTest "simpleTest07"  simpleN3Graph_g6    g6  noError+  , parseTest "simpleTest08"  simpleN3Graph_g7    g7  noError+  , parseTest "simpleTest09"  simpleN3Graph_g8    g8  noError+  , parseTest "simpleTest09b" simpleN3Graph_g8b   g8  noError+  , parseTest "simpleTest10"  simpleN3Graph_g81   g81 noError+  , parseTest "simpleTest12"  simpleN3Graph_g83   g83 noError+  , parseTest "simpleTest12b" simpleN3Graph_g83b  g83 noError+  , parseTest "simpleTest13"  simpleN3Graph_g9    g9  noError+  , parseTest "simpleTest13b" simpleN3Graph_g9b   g9  noError+  , parseTest "simpleTest14"  simpleN3Graph_g10   g10 noError+  , parseTest "simpleTest15"  simpleN3Graph_g11   g11 noError+  , parseTest "simpleTest16"  simpleN3Graph_g12   g12 noError+  , parseTest "simpleTest17"  simpleN3Graph_g17   g17 noError+  ]++------------------------------------------------------------+--  Literal parser tests+------------------------------------------------------------+--+--  Expand upon the literal testing done above+--++litN3Graph_g1 :: String+litN3Graph_g1 =+    commonPrefixes +++    " base1:s1 base1:p1 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n" +++    " base2:s2 base2:p2 \"false\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n" +++    " base3:s3 base3:p3 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n"+    +litN3Graph_g2 :: String+litN3Graph_g2 =+    commonPrefixes +++    " base1:s1 base1:p1 @true.\n" +++    " base2:s2 base2:p2 @false.\n" +++    " base3:s3 base3:p3 true.\n"+    +lit_g1 :: RDFGraph+lit_g1 = toGraph [ arc s1 p1 bTrue+                 , arc s2 p2 bFalse+                 , arc s3 p3 bTrue+                 ]++litTestSuite :: Test+litTestSuite = TestList+  [ parseTest "litTest01" litN3Graph_g1 lit_g1  noError+  , parseTest "litTest02" litN3Graph_g2 lit_g1  noError+  ]++------------------------------------------------------------+--  Exotic parser tests+------------------------------------------------------------+--+--  These tests cover various forms of anonymous nodes+--  [...], lists and formula. together with uses of ':-'+--++--  Simple anon nodes, with semicolons and commas+exoticN3Graph_x1 :: String+exoticN3Graph_x1 =+    commonPrefixes +++    " [ base1:p1 base1:o1 ; \n" +++    "   base1:p1 base2:o2 ; \n" +++    "   base2:p2 base2:o2 ; \n" +++    "   base2:p2 base3:o3 ] = base1:s1 . \n" +++    " base2:s2 = \n" +++    " [ base1:p1 base1:o1 , \n" +++    "   base2:o2 , \n" +++    "   base3:o3 , \n" +++    "   \"l1\"   ; \n" +++    "   base2:p2 base1:o1 , \n" +++    "            base2:o2 , \n" +++    "            base3:o3 , \n" +++    "            \"l1\"   ] . \n"++-- check semi-colons at end of property list+exoticN3Graph_x1b :: String+exoticN3Graph_x1b =+    commonPrefixes +++    " [ base1:p1 base1:o1 ; \n" +++    "   base1:p1 base2:o2 ; \n" +++    "   base2:p2 base2:o2 ; \n" +++    "   base2:p2 base3:o3; ] = base1:s1 . \n" +++    " base2:s2 = \n" +++    " [ base1:p1 base1:o1 , \n" +++    "   base2:o2 , \n" +++    "   base3:o3 , \n" +++    "   \"l1\"   ; \n" +++    "   base2:p2 base1:o1 , \n" +++    "            base2:o2 , \n" +++    "            base3:o3 , \n" +++    "            \"l1\" ;  ] ;. \n"++--  Simple anon nodes, with 'is ... of' and semicolons and commas+exoticN3Graph_x2 :: String+exoticN3Graph_x2 =+    commonPrefixes +++    " [ @has base1:p1     base1:o1 ; \n" +++    "   @is  base1:p1 @of base2:o2 ; \n" +++    "   @has base2:p2     base2:o2 ; \n" +++    "   @is  base2:p2 @of base3:o3 ] = base1:s1 . \n" +++    " base2:s2 = \n" +++    " [ @has base1:p1 base1:o1 , \n" +++    "                 base2:o2 , \n" +++    "                 base3:o3 , \n" +++    "                 \"l1\"   ; \n" +++    "   @is  base2:p2 @of base1:o1 , \n" +++    "                     base2:o2 , \n" +++    "                     base3:o3 , \n" +++    "                     \"l1\"   ] . \n"+++--  List nodes++exoticN3Graph_x4 :: String+exoticN3Graph_x4 =+    commonPrefixes +++    " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"++exoticN3Graph_x5 :: String+exoticN3Graph_x5 =+    commonPrefixes +++    " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"++--  Formula nodes, with and without :-++exoticN3Graph_x7 :: String+exoticN3Graph_x7 =+    commonPrefixes +++    " { base1:s1 base1:p1 base1:o1 .   \n" +++    "   base2:s2 base1:p1 base2:o2 .   \n" +++    "   base3:s3 base1:p1 base3:o3 . } \n" +++    " base2:p2 base2:f2 . "++--  Test allocation of bnodes carries over a nested formula+exoticN3Graph_x12 :: String+exoticN3Graph_x12 =+    commonPrefixes +++    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" +++    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" +++    "            base2:p2 base2:f2 .                \n" +++    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."++exoticTestSuite :: Test+exoticTestSuite = +  TestList+  [ parseTest "exoticTest01"  exoticN3Graph_x1   x1  noError+  , parseTest "exoticTest01b" exoticN3Graph_x1b  x1  noError+  , parseTest "exoticTest02"  exoticN3Graph_x2   x2  noError+  , parseTest "exoticTest04" exoticN3Graph_x4  x4  noError+  , parseTest "exoticTest05" exoticN3Graph_x5  x5  noError+  , parseTest "exoticTest07" exoticN3Graph_x7  x7  noError+  , parseTest "exoticTest12" exoticN3Graph_x12 x12 noError+  , testGraphEq "exoticTest20" False x7 x8+  , testGraphEq "exoticTest21" False x8 x9+  ]++keywordN3Graph_01 :: String+keywordN3Graph_01 = +  "@keywords .\n" +++  "b a c . "++-- a modification of simpleN3Graph_g8+keywordN3Graph_02 :: String+keywordN3Graph_02 = +    commonPrefixes +++    "@keywords a , is, of ,has.\n" +++    " base1:s1 a base1:o1 . \n" +++    " base2:s2 = base2:o2 . \n" +++    " base1:s1 is  base1:p1 of base1:o1 . \n" +++    " base2:s2 has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++-- a modification of simpleN3Graph_g83+keywordN3Graph_03 :: String+keywordN3Graph_03 = +    commonPrefixes +++    "@keywords of.\n" +++    " base1:s1 @is  base1:p1 of base1:o1 . \n" +++    " base2:s2 @has base1:p1 base2:o2 . \n" +++    " base1:s1 => base1:o1 . \n" +++    " base2:s2 <= base2:o2 . \n"++keywordTestSuite :: Test+keywordTestSuite = TestList+  [ parseTestB dqn "keywordTest01" keywordN3Graph_01  kg1  noError+  , parseTest "keywordTest02"      keywordN3Graph_02  g8  noError+  , parseTest "keywordTest03"      keywordN3Graph_03  g83 noError+  ]+    +------------------------------------------------------------+--  Test parser failure+------------------------------------------------------------+--+--  Very limited at the moment.+--++failTest :: String -> String -> String -> Test+failTest lbl gr pe = parseTest lbl gr emptyRDFGraph pe++failN3Graph_g1 :: String+failN3Graph_g1 =+    commonPrefixes +++    " base1:s1 base2:p2 unknown3:o3 . "++fail1 :: String+fail1 = intercalate "\n" [+         "",+         "@prefix base3 : <http://id.ninebynine.org/wip/2003/test/graph3/node> . ",+         " base1:s1 base2:p2 unknown3:o3 . ",+         "                            ^",+         "(line 4, column 29 indicated by the '^' sign above):",+         "",+         "unexpected Prefix 'unknown3:' not bound."+        ]++failTestSuite :: Test+failTestSuite = TestList+  [ failTest "failTest01" failN3Graph_g1 fail1+  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ charTestSuite+  , nameTestSuite+  , prefixTestSuite+  , absUriRefTestSuite+  , uriRef2TestSuite+  , simpleTestSuite+  , litTestSuite+  , exoticTestSuite+  , keywordTestSuite+  , failTestSuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/NTTest.hs view
@@ -0,0 +1,268 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  NTTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This Module contains test cases for the NTriples modules: +--  "NTParser" and "NTFormatter".+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.NTParser (parseNT)+import Swish.RDF.NTFormatter (formatGraphAsString)++import Swish.RDF.RDFGraph+  ( RDFGraph, RDFLabel(..)+    , emptyRDFGraph +    , toRDFGraph+    )++import Swish.Utils.Namespace (makeUriScopedName)++import Swish.RDF.Vocabulary (langName, rdf_XMLLiteral)++import Swish.RDF.GraphClass (arc)++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertEqual, runTestTT )++------------------------------------------------------------+--  Parser tests+------------------------------------------------------------++-- check that parsing the input creates the expected graph++checkGraph :: String -> String -> RDFGraph -> Test+checkGraph lab inp gr =+    TestList+      [ TestCase ( assertEqual ("parse-failed:"++lab) noError pe )+      , TestCase ( assertEqual ("parse-result:"++lab) gr pg )+      ]+    where+      (pe,pg) = case parseNT inp of+        Right g -> (noError, g)+        Left  s -> (s, emptyRDFGraph)+            +noError :: String+noError = ""++-- check that the +--    parseNT input == parseNT (formatGraph (parse NT input))+--+roundTrip :: String -> String -> Test+roundTrip lbl inp = +  let (pErr1, pGr1) = case parseNT inp of+        Right g -> (noError, g)+        Left  s -> (s, emptyRDFGraph)+        +      inp2 = formatGraphAsString pGr1+      +      (pErr2, pGr2) = case parseNT inp2 of+        Right g -> (noError, g)+        Left  s -> (s, emptyRDFGraph)+        +  in TestList+    [ TestCase (assertEqual ("roundTrip-parsing1:"++lbl) noError pErr1)+    , TestCase (assertEqual ("roundTrip-parsing2:"++lbl) noError pErr2)+    , TestCase (assertEqual ("roundTrip-graph:"++lbl)    pGr1    pGr2)+    ]+++------------------------------------------------------------+--  Rather than bother with locating an external file,+--  include it directly.+--+--  This is the contents of+--    http://www.w3.org/2000/10/rdf-tests/rdfcore/ntriples/test.nt+--  retrived on 2011-03-23 11:25:46+--+------------------------------------------------------------++w3cTest :: String+w3cTest = "#\n# Copyright World Wide Web Consortium, (Massachusetts Institute of\n# Technology, Institut National de Recherche en Informatique et en\n# Automatique, Keio University).\n#\n# All Rights Reserved.\n#\n# Please see the full Copyright clause at\n# <http://www.w3.org/Consortium/Legal/copyright-software.html>\n#\n# Test file with a variety of legal N-Triples\n#\n# Dave Beckett - http://purl.org/net/dajobe/\n# \n# $Id: test.nt,v 1.7 2003/10/06 15:52:19 dbeckett2 Exp $\n# \n#####################################################################\n\n# comment lines\n  \t  \t   # comment line after whitespace\n# empty blank line, then one with spaces and tabs\n\n         \t\n<http://example.org/resource1> <http://example.org/property> <http://example.org/resource2> .\n_:anon <http://example.org/property> <http://example.org/resource2> .\n<http://example.org/resource2> <http://example.org/property> _:anon .\n# spaces and tabs throughout:\n \t <http://example.org/resource3> \t <http://example.org/property>\t <http://example.org/resource2> \t.\t \n\n# line ending with CR NL (ASCII 13, ASCII 10)\n<http://example.org/resource4> <http://example.org/property> <http://example.org/resource2> .\r\n\n# 2 statement lines separated by single CR (ASCII 10)\n<http://example.org/resource5> <http://example.org/property> <http://example.org/resource2> .\r<http://example.org/resource6> <http://example.org/property> <http://example.org/resource2> .\n\n\n# All literal escapes\n<http://example.org/resource7> <http://example.org/property> \"simple literal\" .\n<http://example.org/resource8> <http://example.org/property> \"backslash:\\\\\" .\n<http://example.org/resource9> <http://example.org/property> \"dquote:\\\"\" .\n<http://example.org/resource10> <http://example.org/property> \"newline:\\n\" .\n<http://example.org/resource11> <http://example.org/property> \"return\\r\" .\n<http://example.org/resource12> <http://example.org/property> \"tab:\\t\" .\n\n# Space is optional before final .\n<http://example.org/resource13> <http://example.org/property> <http://example.org/resource2>.\n<http://example.org/resource14> <http://example.org/property> \"x\".\n<http://example.org/resource15> <http://example.org/property> _:anon.\n\n# \\u and \\U escapes\n# latin small letter e with acute symbol \\u00E9 - 3 UTF-8 bytes #xC3 #A9\n<http://example.org/resource16> <http://example.org/property> \"\\u00E9\" .\n# Euro symbol \\u20ac  - 3 UTF-8 bytes #xE2 #x82 #xAC\n<http://example.org/resource17> <http://example.org/property> \"\\u20AC\" .\n# resource18 test removed\n# resource19 test removed\n# resource20 test removed\n\n# XML Literals as Datatyped Literals\n<http://example.org/resource21> <http://example.org/property> \"\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource22> <http://example.org/property> \" \"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource23> <http://example.org/property> \"x\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource23> <http://example.org/property> \"\\\"\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource24> <http://example.org/property> \"<a></a>\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource25> <http://example.org/property> \"a <b></b>\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource26> <http://example.org/property> \"a <b></b> c\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource26> <http://example.org/property> \"a\\n<b></b>\\nc\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource27> <http://example.org/property> \"chat\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n# resource28 test removed 2003-08-03\n# resource29 test removed 2003-08-03\n\n# Plain literals with languages\n<http://example.org/resource30> <http://example.org/property> \"chat\"@fr .\n<http://example.org/resource31> <http://example.org/property> \"chat\"@en .\n\n# Typed Literals\n<http://example.org/resource32> <http://example.org/property> \"abc\"^^<http://example.org/datatype1> .\n# resource33 test removed 2003-08-03\n"  +  +------------------------------------------------------------+--  Define some common values+------------------------------------------------------------++s1, p1, p2, o1 :: RDFLabel+s1 = Res $ makeUriScopedName "urn:b#s1"+p1 = Res $ makeUriScopedName "urn:b#p1"+p2 = Res $ makeUriScopedName "http://example.com/pred2"+o1 = Res $ makeUriScopedName "urn:b#o1"++l0, l1, l2, l3 :: RDFLabel+l0 = Lit "" Nothing+l1 = Lit "l1"  Nothing+l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing+l3 = Lit "l3--\r\"'\\--\x20&--\x17A&--" Nothing++lfr, lgben, lxml1, lxml2 :: RDFLabel+lfr    = Lit "chat"          (Just $ langName "fr")+lgben  = Lit "football"      (Just $ langName "en-gb")+lxml1  = Lit "<br/>"         (Just rdf_XMLLiteral)+lxml2  = Lit "<em>chat</em>" (Just rdf_XMLLiteral)++b1 , b2 :: RDFLabel+b1 = Blank "x1"+b2 = Blank "genid23"++------------------------------------------------------------+--  Construct graphs for testing+------------------------------------------------------------++g0 :: RDFGraph+g0 = toRDFGraph []++mkGr1 :: RDFLabel -> RDFLabel -> RDFLabel -> RDFGraph+mkGr1 s p o = toRDFGraph [arc s p o]++g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11 :: RDFGraph+g1 = mkGr1 s1 p1 o1+g2 = mkGr1 s1 p1 l0+g3 = mkGr1 s1 p1 l1+g4 = mkGr1 s1 p1 l2+g5 = mkGr1 s1 p1 l3+g6 = mkGr1 s1 p1 lfr+g7 = mkGr1 s1 p1 lgben+g8 = mkGr1 s1 p1 lxml1+g9 = mkGr1 s1 p1 lxml2+g10 = mkGr1 s1 p1 b1+g11 = mkGr1 b2 p1 b1++gm1 :: RDFGraph+gm1 = toRDFGraph [arc b2 p2 b1, arc b2 p1 o1]++------------------------------------------------------------+--  Input documents+------------------------------------------------------------++empty1, empty2, empty3, empty4, empty5 :: String++{-+empty3 and empty4 are not valid NTriple documents since they do+not end with a \n, but we support this for now.+-}+empty1 = ""+empty2 = "\n"+empty3 = "  \n  "+empty4 = "# a comment"+empty5 = "\n   # a comment\n "++graph1, graph2, graph3, graph4, graph5, graph6, graph7, graph8,+  graph9, graph10, graph11 :: String++graph1 = "<urn:b#s1> <urn:b#p1> <urn:b#o1>."+graph2 = "<urn:b#s1> <urn:b#p1>  \"\"."+graph3 = "<urn:b#s1> <urn:b#p1> \"l1\" . "+graph4 = "<urn:b#s1> <urn:b#p1> \"l2-'\\\"line1\\\"'\\n\\nl2-'\\\"\\\"line2\\\"\\\"'\"."+graph5 = "<urn:b#s1> <urn:b#p1>  \"l3--\\r\\\"'\\\\--\\u0020&--\\U0000017A&--\" ."+graph6 = "<urn:b#s1> <urn:b#p1> \"chat\"@fr."+graph7 = "<urn:b#s1> <urn:b#p1> \"football\"@en-gb . "+graph8 = "<urn:b#s1> <urn:b#p1> \"<br/>\"^^<http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral>."+graph9 = "<urn:b#s1> <urn:b#p1> \"<em>chat</em>\"^^<http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral>."+graph10 = "<urn:b#s1> <urn:b#p1> _:x1 . "+graph11 = "_:genid23  <urn:b#p1> _:x1 . "++graphm1, graphm1r :: String++graphm1 = "_:genid23 <urn:b#p1> <urn:b#o1> .\n\n # test \n_:genid23  <http://example.com/pred2>  _:x1 .\n\n"+graphm1r = "_:genid23 <http://example.com/pred2> _:x1.\n_:genid23  <urn:b#p1> <urn:b#o1>.\n"++------------------------------------------------------------+--  Parser tests+------------------------------------------------------------++rTests :: Test+rTests = TestList +         [ roundTrip "empty1" empty1+         , roundTrip "empty2" empty2+         , roundTrip "empty3" empty3+         , roundTrip "empty4" empty4+         , roundTrip "empty5" empty5+         , roundTrip "graph1" graph1 +         , roundTrip "graph2" graph2 +         , roundTrip "graph3" graph3 +         , roundTrip "graph4" graph4 +         , roundTrip "graph5" graph5 +         , roundTrip "graph6" graph6 +         , roundTrip "graph7" graph7 +         , roundTrip "graph8" graph8 +         , roundTrip "graph9" graph9 +         , roundTrip "graph10" graph10 +         , roundTrip "graph11" graph11 +         , roundTrip "graphm1" graphm1 +         , roundTrip "graphm1r" graphm1r +         , roundTrip "W3C test" w3cTest+         ]++eTests :: Test+eTests = TestList +         [ checkGraph "empty1" empty1 g0+         , checkGraph "empty2" empty2 g0+         , checkGraph "empty3" empty3 g0+         , checkGraph "empty4" empty4 g0+         , checkGraph "empty5" empty5 g0+         ]+         +gTests :: Test+gTests = TestList +         [ checkGraph "graph1" graph1 g1+         , checkGraph "graph2" graph2 g2+         , checkGraph "graph3" graph3 g3+         , checkGraph "graph4" graph4 g4+         , checkGraph "graph5" graph5 g5+         , checkGraph "graph6" graph6 g6+         , checkGraph "graph7" graph7 g7+         , checkGraph "graph8" graph8 g8+         , checkGraph "graph9" graph9 g9+         , checkGraph "graph10" graph10 g10+         , checkGraph "graph11" graph11 g11+         , checkGraph "graphm1" graphm1 gm1+         , checkGraph "graphm1r" graphm1r gm1+         ]++allTests :: Test              +allTests = +  TestList+  [ rTests+  , eTests+  , gTests+  ]+  +main :: IO ()  +main = runTestTT allTests >> return ()++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/QNameTest.hs view
@@ -0,0 +1,334 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  QNameTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines test cases for QName data+--+--------------------------------------------------------------------------------++module Main where++import Swish.Utils.QName+    ( QName(..)+    , newQName, qnameFromPair, qnameFromURI+    , getNamespace, getLocalName, getQNameURI+    , splitURI+    )++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertEqual+    , runTestTT+    )+++++------------------------------------------------------------+--  Define some common values+------------------------------------------------------------++base1, base2, base3, base4, base5 :: String+base1  = "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2  = "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3  = "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4  = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"+base5  = "http://id.ninebynine.org/wip/2003/test/graph5/"++qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: QName+qb1s1  = QName base1 "s1"+qb2s2  = QName base2 "s2"+qb3s3  = QName base3 "s3"+qb3    = QName base3 ""+qb3bm  = QName base3 "basemore"+qb4m   = QName base4 "more"++qb5, qb5s5 :: QName+qb5    = QName base5 ""+qb5s5  = QName base5 "s5"++qb1st1, qb2st2, qb3st3 :: QName+qb1st1 = QName base1 "st1"+qb2st2 = QName base2 "st2"+qb3st3 = QName base3 "st3"++------------------------------------------------------------+--  QName equality tests+------------------------------------------------------------++testQNameEq :: String -> Bool -> QName -> QName -> Test+testQNameEq lab eq n1 n2 =+    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )++qnlist :: [(String, QName)]+qnlist =+  [ ("qb1s1", qb1s1)+  , ("qb2s2", qb2s2)+  , ("qb3s3", qb3s3)+  , ("qb3",   qb3)+  , ("qb3bm", qb3bm)+  , ("qb4m",  qb4m)+  , ("qb5",   qb5)+  , ("qb5s5", qb5s5)+  , ("qb1st1",qb1st1)+  , ("qb2st2",qb2st2)+  , ("qb3st3",qb3st3)+  ]++qneqlist :: [(String, String)]+qneqlist =+  [ ("qb3bm","qb4m")+  ]++testQNameEqSuite :: Test+testQNameEqSuite = TestList+  [ testQNameEq (testLab l1 l2) (testEq  l1 l2) n1 n2+      | (l1,n1) <- qnlist , (l2,n2) <- qnlist ]+    where+    testLab l1 l2 = l1 ++ "-" ++ l2+    testEq  l1 l2 = (l1 == l2)        ||+            (l1,l2) `elem` qneqlist ||+            (l2,l1) `elem` qneqlist++------------------------------------------------------------+--  Alternative constructors+------------------------------------------------------------++nq1, nq2 :: QName+nq1 = newQName base1 "s1"+nq2 = newQName base1 "s2"++qp1, qp2 :: QName+qp1 = qnameFromPair (base1,"s1")+qp2 = qnameFromPair (base1,"s2")++qu1, qu2, qu3, qu4, qu5 :: QName+qu1 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"+qu2 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"+qu3 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph3/node"+qu4 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/"+qu5 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/s5"++testMakeQNameSuite :: Test+testMakeQNameSuite = +  TestList+  [ testQNameEq "testnq01" True  nq1 qb1s1+  , testQNameEq "testnq02" False nq2 qb1s1+  , testQNameEq "testqp01" True  qp1 qb1s1+  , testQNameEq "testqp02" False qp2 qb1s1+  , testQNameEq "testqu01" True qb1s1 qu1+  , testQNameEq "testqu02" True qb2s2 qu2+  , testQNameEq "testqu03" True qb3   qu3+  , testQNameEq "testqu04" True qb5   qu4+  , testQNameEq "testqu05" True qb5s5 qu5+  ]++------------------------------------------------------------+--  Extract components+------------------------------------------------------------++testStringEq :: String -> String -> String -> Test+testStringEq lab s1 s2 =+    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )++testPartQNameSuite :: Test+testPartQNameSuite = +  TestList+  [ testStringEq "testGetNamespace01"+        "http://id.ninebynine.org/wip/2003/test/graph1/node#" +        (getNamespace qb1s1)+  , testStringEq "testGetNamespace02"+        "http://id.ninebynine.org/wip/2003/test/graph2/node/"+        (getNamespace qb2s2)+  , testStringEq "testGetNamespace03"+        "http://id.ninebynine.org/wip/2003/test/graph3/node"+        (getNamespace qb3s3)+  , testStringEq "testGetNamespace04"+        "http://id.ninebynine.org/wip/2003/test/graph3/node"+        (getNamespace qb3)+  , testStringEq "testGetLocalName01"+        "s1" (getLocalName qb1s1)+  , testStringEq "testGetLocalName02"+        "s2" (getLocalName qb2s2)+  , testStringEq "testGetLocalName03"+      "s3" (getLocalName qb3s3)+  , testStringEq "testGetLocalName04"+      "" (getLocalName qb3)+  , testStringEq "testGetQNameURI01"+      "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"+      (getQNameURI qb1s1)+  , testStringEq "testGetQNameURI02"+      "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"+      (getQNameURI qb2s2)+  , testStringEq "testGetQNameURI03"+      "http://id.ninebynine.org/wip/2003/test/graph3/nodes3"+      (getQNameURI qb3s3)+  , testStringEq "testGetQNameURI04"+      "http://id.ninebynine.org/wip/2003/test/graph3/node"+      (getQNameURI qb3)+  ]++------------------------------------------------------------+--  Maybe Qname comparison+------------------------------------------------------------++testMaybeQNameEq :: String -> Bool -> (Maybe QName) -> (Maybe QName) -> Test+testMaybeQNameEq lab eq n1 n2 =+    TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) )++testMaybeQNameEqSuite :: Test+testMaybeQNameEqSuite = +  TestList+  [ testMaybeQNameEq "testMaybeQNameEq01" True+      (Just qb1s1) (Just qb1s1)+  , testMaybeQNameEq "testMaybeQNameEq02" False+      (Just qb1s1) (Just qb2s2)+  , testMaybeQNameEq "testMaybeQNameEq03" False+      (Just qb1s1) Nothing+  , testMaybeQNameEq "testMaybeQNameEq04" False+      Nothing (Just qb1s1)+  , testMaybeQNameEq "testMaybeQNameEq05" True+      Nothing Nothing+  ]++------------------------------------------------------------+--  QName ordering+------------------------------------------------------------++testQNameLe :: String -> Bool -> QName -> QName -> Test+testQNameLe lab le n1 n2 =+    TestCase ( assertEqual ("testQNameLe:"++lab) le (n1<=n2) )++testQNameLeSuite :: Test+testQNameLeSuite = +  TestList+  [testQNameLe "testQNameLe01" True  qb3bm qb4m+  , testQNameLe "testQNameLe02" True  qb4m  qb3bm+  , testQNameLe "testQNameLe03" True  qb1s1 qb2s2+  , testQNameLe "testQNameLe04" False qb2s2 qb1s1+  ]+  +------------------------------------------------------------+--  Show QName+------------------------------------------------------------++testShowQNameSuite :: Test+testShowQNameSuite = +  TestList+  [testStringEq "testShowQName01"+      "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"+      (show qb1s1)+  , testStringEq "testShowQName02"+    "<http://id.ninebynine.org/wip/2003/test/graph2/node/s2>"+    (show qb2s2)+  , testStringEq "testShowQName03"+    "<http://id.ninebynine.org/wip/2003/test/graph3/node>"+    (show qb3)+  , testStringEq "testShowQName04"+    "<http://id.ninebynine.org/wip/2003/test/graph5/>"+    (show qb5)+  ]++------------------------------------------------------------+--  Split URI string into QName parts+------------------------------------------------------------++-- splitURI :: String -> ( String, String )+    -- splitURI "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")+    -- splitURI "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")+    -- splitURI "http://example.org/aaa/"    = ("http://example.org/aaa/","")++testSplitURI :: String -> String -> ( String, String ) -> Test+testSplitURI label input ans =+    TestCase ( assertEqual label ans ( splitURI input ) )++testSplitURISuite :: Test+testSplitURISuite = +  TestList+  [ testSplitURI "testSplitURI01"+      "http://example.org/aaa#bbb"+      ( "http://example.org/aaa#", "bbb" )+  , testSplitURI "testSplitURI02"+     "http://example.org/aaa/bbb"+     ( "http://example.org/aaa/", "bbb" )+  , testSplitURI "testSplitURI03"+     "http://example.org/aaa#"+     ( "http://example.org/aaa#", "" )+  , testSplitURI "testSplitURI04"+     "http://example.org/aaa/"+     ( "http://example.org/aaa/", "" )+  , testSplitURI "testSplitURI05"+     "//example.org/aaa#bbb"+     ( "//example.org/aaa#", "bbb" )+  , testSplitURI "testSplitURI06"+     "aaa/bbb"+     ( "aaa/", "bbb" )+  , testSplitURI "testSplitURI07"+     "aaa/bbb/"+     ( "aaa/bbb/", "" )+     +     -- Thanks to Ian Dickinson of the HP Jena team for spotting this one:+     -- So what *is* the correct split here?+  , testSplitURI "testSplitURI08"+      "mortal"+      ( "", "mortal" )+  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testQNameEqSuite+  , testMakeQNameSuite+  , testPartQNameSuite+  , testMaybeQNameEqSuite+  , testQNameLeSuite+  , testShowQNameSuite+  , testSplitURISuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFDatatypeXsdIntegerTest.hs view
@@ -0,0 +1,1855 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFDatatypeXsdIntegerTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for variable binding values and+--  variable binding modifier values.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.RDFDatatypeXsdInteger+    ( rdfDatatypeXsdInteger+    , rdfDatatypeValXsdInteger+    , typeNameXsdInteger, namespaceXsdInteger+    , axiomsXsdInteger, rulesXsdInteger+    , prefixXsdInteger+    )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding )++import Swish.RDF.RDFRuleset+    ( RDFRule +    , makeRDFGraphFromN3String+    )++import Swish.RDF.RDFDatatype+    ( RDFDatatypeMod+    , applyRDFDatatypeMod+    )++import Swish.RDF.RDFGraph+    ( RDFLabel(..), RDFGraph+    )++import Swish.RDF.ClassRestrictionRule (falseGraphStr)++import Swish.RDF.Datatype+    ( typeName, typeRules, typeMkRules+    , getTypeAxiom, getTypeRule+    , DatatypeVal(..)+    , getDTMod+    , DatatypeMap(..)+    , DatatypeMod(..)+    , nullDatatypeMod+    )++import Swish.RDF.Ruleset+    ( Ruleset(..)+    , getRulesetRule+    )++import Swish.RDF.Rule+    ( Formula(..), Rule(..)+    , nullFormula, nullRule+    )++import Swish.RDF.VarBinding (makeVarBinding)++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    , makeScopedName+    )++import Swish.RDF.Vocabulary (namespaceDefault)++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , mapFindMaybe+    )++import Swish.Utils.ListHelpers+    ( equiv )++import Test.HUnit+    ( Test(TestCase,TestList)+    , Assertion+    , assertBool, assertEqual, assertFailure+    , runTestTT+    )++import Control.Monad (unless)++import Data.Maybe (isJust, fromMaybe)+++------------------------------------------------------------+--  Test case helpers+------------------------------------------------------------++assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion+assertMember preface expected actual =+  unless (expected `elem` actual ) (assertFailure msg)+  where msg = (if null preface then "" else preface ++ "\n") +++             "expected: " ++ show expected ++ "\nbut got: " ++ show actual++test :: String -> Bool -> Test+test lab bv =+    TestCase ( assertBool ("test:"++lab) bv )++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testElem :: (Eq a, Show a) => String -> a -> [a] -> Test+testElem lab a1 as =+    TestCase ( assertMember ("testElem:"++lab) a1 as )++testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test+testLe lab eq a1 a2 =+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )++-- Test for Just x or Nothing++testJust :: String -> Maybe a -> Test+testJust lab av =+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )++testNothing :: String -> Maybe a -> Test+testNothing lab av =+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )++-- Compare lists and lists of lists and Maybe lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+    show (ListTest a) = show a++data MaybeListTest a = MaybeListTest (Maybe [a])++instance (Eq a) => Eq (MaybeListTest a) where+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2+    MaybeListTest Nothing   == MaybeListTest Nothing   = True+    _                       == _                       = False++instance (Show a) => Show (MaybeListTest a) where+    show (MaybeListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test+testEqvEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest $ map ListTest a1+        ma2 = ListTest $ map ListTest a2++testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test+testHasEqv lab a1 a2 =+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest a1+        ma2 = map ListTest a2++testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test+testMaybeEqv lab a1 a2 =+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )+    where+        ma1 = (MaybeListTest a1)+        ma2 = (MaybeListTest a2)++------------------------------------------------------------+--  Misc values+------------------------------------------------------------++xsd_int_name :: String -> ScopedName+xsd_int_name nam  = ScopedName namespaceXsdInteger nam++axiomXsdIntegerDT :: ScopedName+axiomXsdIntegerDT       = xsd_int_name "dt"++ruleXsdIntegerAbs, ruleXsdIntegerNeg, ruleXsdIntegerSum,+  ruleXsdIntegerDiff, ruleXsdIntegerProd, ruleXsdIntegerDivMod,+  ruleXsdIntegerPower, ruleXsdIntegerEq, ruleXsdIntegerNe, +  ruleXsdIntegerLt, ruleXsdIntegerLe, ruleXsdIntegerGt,+  ruleXsdIntegerGe :: ScopedName+ruleXsdIntegerAbs       = xsd_int_name "Abs"+ruleXsdIntegerNeg       = xsd_int_name "Neg"+ruleXsdIntegerSum       = xsd_int_name "Sum"+ruleXsdIntegerDiff      = xsd_int_name "Diff"+ruleXsdIntegerProd      = xsd_int_name "Prod"+ruleXsdIntegerDivMod    = xsd_int_name "DivMod"+ruleXsdIntegerPower     = xsd_int_name "Power"+ruleXsdIntegerEq        = xsd_int_name "Eq"+ruleXsdIntegerNe        = xsd_int_name "Ne"+ruleXsdIntegerLt        = xsd_int_name "Lt"+ruleXsdIntegerLe        = xsd_int_name "Le"+ruleXsdIntegerGt        = xsd_int_name "Gt"+ruleXsdIntegerGe        = xsd_int_name "Ge"++------------------------------------------------------------+--  Basic rdfDatatypeXsdInteger tests+------------------------------------------------------------++getXsdIntegerAxiom :: ScopedName -> Formula RDFGraph+getXsdIntegerAxiom scopnam =+    fromMaybe nullFormula $ getTypeAxiom scopnam rdfDatatypeXsdInteger++getXsdIntegerRule :: ScopedName -> Rule RDFGraph+getXsdIntegerRule scopnam =+    fromMaybe nullRule $ getTypeRule scopnam rdfDatatypeXsdInteger++getXsdIntegerDTmod :: ScopedName -> DatatypeMod Integer RDFLabel RDFLabel+getXsdIntegerDTmod scopnam =+    fromMaybe nullDatatypeMod $ getDTMod scopnam rdfDatatypeValXsdInteger++testDatatypeSuite :: Test+testDatatypeSuite = +  TestList+  [ testEq  "testDatatype01" typeNameXsdInteger $+    typeName rdfDatatypeXsdInteger+  , testEq  "testDatatype02" namespaceXsdInteger $+    rsNamespace (typeRules rdfDatatypeXsdInteger)+  , testEqv "testDatatype03" axiomsXsdInteger $+    rsAxioms (typeRules rdfDatatypeXsdInteger)+  , testEqv "testDatatype04" rulesXsdInteger $+    rsRules (typeRules rdfDatatypeXsdInteger)+  , testEq "testDatatype05" axiomXsdIntegerDT $+    formName (getXsdIntegerAxiom axiomXsdIntegerDT)+  , testEq "testDatatype06" ruleXsdIntegerAbs $+    ruleName (getXsdIntegerRule ruleXsdIntegerAbs)+  ]+  +------------------------------------------------------------+--  Basic rdfDatatypeValXsdInteger tests+------------------------------------------------------------++testDatatypeValSuite :: Test+testDatatypeValSuite = +  TestList+  [ testEq  "testDatatypeVal01" (Just 123) $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "123"+  , testEq  "testDatatypeVal02" (Just 0) $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "0"+  , testEq  "testDatatypeVal03" (Just 456) $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "+000456"+  , testEq  "testDatatypeVal04" (Just (-987)) $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "-0987"+  , testEq  "testDatatypeVal05" Nothing $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "11x2"+  , testEq  "testDatatypeVal06" Nothing $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) " 321"+  , testEq  "testDatatypeVal07" Nothing $+       mapL2V (tvalMap rdfDatatypeValXsdInteger) "321 "++  , testEq  "testDatatypeVal11" (Just "123") $+       mapV2L (tvalMap rdfDatatypeValXsdInteger) 123+  , testEq  "testDatatypeVal12" (Just "-987") $+       mapV2L (tvalMap rdfDatatypeValXsdInteger) (-987)++  , testElem "testDatatypeVal21" dmodXsdIntegerAbs $+       map dmName (tvalMod rdfDatatypeValXsdInteger)+  , testEq "testDatatypeVal22" dmodXsdIntegerAbs $+       dmName (getXsdIntegerDTmod dmodXsdIntegerAbs)+  ]++------------------------------------------------------------+--  Variable binding modifier tests+------------------------------------------------------------++dmodXsdIntegerAbs, dmodXsdIntegerNeg, dmodXsdIntegerSum, +  dmodXsdIntegerDiff, dmodXsdIntegerProd, dmodXsdIntegerDivMod, +  dmodXsdIntegerPower, dmodXsdIntegerEq, dmodXsdIntegerNe, +  dmodXsdIntegerLt, dmodXsdIntegerLe, dmodXsdIntegerGt, +  dmodXsdIntegerGe :: ScopedName++dmodXsdIntegerAbs    = xsd_int_name "abs"+dmodXsdIntegerNeg    = xsd_int_name "neg"+dmodXsdIntegerSum    = xsd_int_name "sum"+dmodXsdIntegerDiff   = xsd_int_name "diff"+dmodXsdIntegerProd   = xsd_int_name "prod"+dmodXsdIntegerDivMod = xsd_int_name "divmod"+dmodXsdIntegerPower  = xsd_int_name "power"+dmodXsdIntegerEq     = xsd_int_name "eq"+dmodXsdIntegerNe     = xsd_int_name "ne"+dmodXsdIntegerLt     = xsd_int_name "lt"+dmodXsdIntegerLe     = xsd_int_name "le"+dmodXsdIntegerGt     = xsd_int_name "gt"+dmodXsdIntegerGe     = xsd_int_name "ge"++testVmodN :: [RDFLabel]+    -> String -> Maybe (RDFDatatypeMod Integer)+    -> [RDFVarBinding] -> [RDFVarBinding]+    -> Test+testVmodN vars lab (Just dmod) ibinds obinds =+    testEqv lab obinds $+        applyRDFDatatypeMod rdfDatatypeValXsdInteger dmod vars ibinds+testVmodN _ lab Nothing _ _ = TestCase $+    assertFailure $ "testVmodN:"++lab++", null variable binding modifier"++testVmod2, testVmod3, testVmod4 :: +  String -> Maybe (RDFDatatypeMod Integer)+  -> [RDFVarBinding] -> [RDFVarBinding]+  -> Test+testVmod2 = testVmodN [(Var "a"),(Var "b")]+testVmod3 = testVmodN [(Var "a"),(Var "b"),(Var "c")]+testVmod4 = testVmodN [(Var "a"),(Var "b"),(Var "c"),(Var "d")]++--  make various kinds of RDF variable bindings++rdfVR :: (String, ScopedName) -> (RDFLabel, RDFLabel)+rdfVR (v,u) = (Var v,Res u)                     -- (Variable,Resource)++rdfVB :: (String, String) -> (RDFLabel, RDFLabel)+rdfVB (v,b) = (Var v,Blank b)                   -- (Variable,Blank)++rdfVL :: (String, String) -> (RDFLabel, RDFLabel)+rdfVL (v,l) = (Var v,Lit l Nothing)             -- (Variable,Untyped literal)++rdfVI :: (String, String) -> (RDFLabel, RDFLabel)+rdfVI (v,l) = (Var v,Lit l (Just typeNameXsdInteger))+                                                -- (Variable,Integer literal)++makeBVR :: [(String,ScopedName)] -> RDFVarBinding+makeBVR nls = makeVarBinding $ map rdfVR nls++makeBVB :: [(String,String)] -> RDFVarBinding+makeBVB nls = makeVarBinding $ map rdfVB nls++makeBVI :: [(String,String)] -> RDFVarBinding+makeBVI nls = makeVarBinding $ map rdfVI nls++makeBVL :: [(String,String)] -> RDFVarBinding+makeBVL nls = makeVarBinding $ map rdfVL nls++--  Test null modifier++testVarModify00 :: Test+testVarModify00 = testVmod2  "testVarModify00"+                    (Just nullDatatypeMod)+                    [makeBVI [("a","123")]]+                    [makeBVI [("a","123")]]++--  Tests for xsd_integer:abs++testVarModifyAbs01, testVarModifyAbs02, testVarModifyAbs03,+  testVarModifyAbs04, testVarModifyAbs05, testVarModifyAbs06,+  testVarModifyAbs07, testVarModifyAbs08, testVarModifyAbs09,+  testVarModifyAbs10 :: Test+testVarModifyAbs01 = testVmod2  "testVarModifyAbs01"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("b","123")]]+                    [makeBVI [("a","123"),("b","123")]]++testVarModifyAbs02 = testVmod2  "testVarModifyAbs02"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("b","-123")]]+                    [makeBVI [("a","123"),("b","-123")]]++testVarModifyAbs03 = testVmod2  "testVarModifyAbs03"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("a","123"),("b","123")]]+                    [makeBVI [("a","123"),("b","123")]]++testVarModifyAbs04 = testVmod2  "testVarModifyAbs04"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("a","123"),("b","-123")]]+                    [makeBVI [("a","123"),("b","-123")]]++testVarModifyAbs05 = testVmod2  "testVarModifyAbs05"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-123"),("b","123")]]+                    []++testVarModifyAbs06 = testVmod2  "testVarModifyAbs06"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("a","123"),("b","456")]]+                    []++testVarModifyAbs07 = testVmod2  "testVarModifyAbs07"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVI [("c","123")]]+                    []++testVarModifyAbs08 = testVmod2  "testVarModifyAbs08"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVL [("b","123")]]+                    []++testVarModifyAbs09 = testVmod2  "testVarModifyAbs09"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVR [("b",makeScopedName "" "http://ex.org/" "123")]]+                    []++testVarModifyAbs10 = testVmod2  "testVarModifyAbs10"+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+                    [makeBVB [("b","123")]]+                    []++--  Tests for xsd_integer:neg++testVarModifyNeg01, testVarModifyNeg02, testVarModifyNeg03,+  testVarModifyNeg04, testVarModifyNeg05 :: Test++testVarModifyNeg01 = testVmod2  "testVarModifyNeg01"+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+                    [makeBVI [("a","123"),("b","-123")]]+                    [makeBVI [("a","123"),("b","-123")]]++testVarModifyNeg02 = testVmod2  "testVarModifyNeg02"+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-123"),("b","123")]]+                    [makeBVI [("a","-123"),("b","123")]]++testVarModifyNeg03 = testVmod2  "testVarModifyNeg03"+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+                    [makeBVI [("a","123"),("b","123")]]+                    []++testVarModifyNeg04 = testVmod2  "testVarModifyNeg04"+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+                    [makeBVI [("b","123")]]+                    [makeBVI [("a","-123"),("b","123")]]++testVarModifyNeg05 = testVmod2  "testVarModifyNeg05"+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-123")]]+                    [makeBVI [("a","-123"),("b","123")]]++--  Tests for xsd_integer:sum++testVarModifySum01, testVarModifySum02, testVarModifySum03,+  testVarModifySum04, testVarModifySum05 :: Test++testVarModifySum01 = testVmod3  "testVarModifySum01"+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+                    [makeBVI [("a","33"),("b","22"),("c","11")]]+                    [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum02 = testVmod3  "testVarModifySum02"+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+                    [makeBVI [("b","22"),("c","11")]]+                    [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum03 = testVmod3  "testVarModifySum03"+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+                    [makeBVI [("a","33"),("c","11")]]+                    [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum04 = testVmod3  "testVarModifySum04"+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+                    [makeBVI [("a","33"),("b","22")]]+                    [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum05 = testVmod3  "testVarModifySum05"+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+                    [makeBVI [("a","44"),("b","22"),("c","11")]]+                    []++--  Tests for xsd_integer:diff++testVarModifyDiff01, testVarModifyDiff02, testVarModifyDiff03,+  testVarModifyDiff04, testVarModifyDiff05 :: Test++testVarModifyDiff01 = testVmod3  "testVarModifyDiff01"+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+                    [makeBVI [("a","11"),("b","33"),("c","22")]]+                    [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff02 = testVmod3  "testVarModifyDiff02"+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+                    [makeBVI [("b","33"),("c","22")]]+                    [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff03 = testVmod3  "testVarModifyDiff03"+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+                    [makeBVI [("a","11"),("c","22")]]+                    [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff04 = testVmod3  "testVarModifyDiff04"+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+                    [makeBVI [("a","11"),("b","33")]]+                    [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff05 = testVmod3  "testVarModifyDiff05"+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+                    [makeBVI [("a","11"),("b","44"),("c","22")]]+                    []++--  Tests for xsd_integer:prod+--+--  Note:   product can also be used to test if a value is+--          an exact multiple of some other.++testVarModifyProd01, testVarModifyProd02, testVarModifyProd03,+  testVarModifyProd04, testVarModifyProd05,+  testVarModifyProd06 :: Test++testVarModifyProd01 = testVmod3  "testVarModifyProd01"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("a","6"),("b","2"),("c","3")]]+                    [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd02 = testVmod3  "testVarModifyProd02"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("b","2"),("c","3")]]+                    [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd03 = testVmod3  "testVarModifyProd03"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("a","6"),("c","3")]]+                    [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd04 = testVmod3  "testVarModifyProd04"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("a","6"),("c","3")]]+                    [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd05 = testVmod3  "testVarModifyProd05"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("a","7"),("b","2"),("c","3")]]+                    []++testVarModifyProd06 = testVmod3  "testVarModifyProd06"+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+                    [makeBVI [("a","7"),("b","2")]]+                    []++--  Tests for xsd_integer:divmod+--+--  Note:   truncates downwards, so remainder is same sign as divisor+--          cf. Haskell divMod function.++testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03,+  testVarModifyDivMod04, testVarModifyDivMod05,+  testVarModifyDivMod06, testVarModifyDivMod07 :: Test++testVarModifyDivMod01 = testVmod4  "testVarModifyDivMod01"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]++testVarModifyDivMod02 = testVmod4  "testVarModifyDivMod02"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("c","7"),("d","3")]]+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]++testVarModifyDivMod03 = testVmod4  "testVarModifyDivMod03"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("c","-7"),("d","3")]]+                    [makeBVI [("a","-3"),("b","2"),("c","-7"),("d","3")]]++testVarModifyDivMod04 = testVmod4  "testVarModifyDivMod04"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("c","7"),("d","-3")]]+                    [makeBVI [("a","-3"),("b","-2"),("c","7"),("d","-3")]]++testVarModifyDivMod05 = testVmod4  "testVarModifyDivMod05"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("c","-7"),("d","-3")]]+                    [makeBVI [("a","2"),("b","-1"),("c","-7"),("d","-3")]]++testVarModifyDivMod06 = testVmod4  "testVarModifyDivMod06"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("a","2"),("b","5"),("c","7"),("d","3")]]+                    []++testVarModifyDivMod07 = testVmod4  "testVarModifyDivMod07"+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+                    [makeBVI [("a","2"),("b","1"),("d","3")]]+                    []++--  Tests for xsd_integer:power++testVarModifyPower01, testVarModifyPower02, testVarModifyPower03,+  testVarModifyPower04, testVarModifyPower05,+  testVarModifyPower06, testVarModifyPower07,+  testVarModifyPower08 :: Test++testVarModifyPower01 = testVmod3  "testVarModifyPower01"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("a","8"),("b","2"),("c","3")]]+                    [makeBVI [("a","8"),("b","2"),("c","3")]]++testVarModifyPower02 = testVmod3  "testVarModifyPower02"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("b","2"),("c","3")]]+                    [makeBVI [("a","8"),("b","2"),("c","3")]]++testVarModifyPower03 = testVmod3  "testVarModifyPower03"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("a","8"),("c","3")]]+                    []++testVarModifyPower04 = testVmod3  "testVarModifyPower04"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("a","8"),("b","2")]]+                    []++testVarModifyPower05 = testVmod3  "testVarModifyPower05"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("a","8"),("b","3"),("c","2")]]+                    []++testVarModifyPower06 = testVmod3  "testVarModifyPower06"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("b","55"),("c","0")]]+                    [makeBVI [("a","1"),("b","55"),("c","0")]]++testVarModifyPower07 = testVmod3  "testVarModifyPower07"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("b","-2"),("c","3")]]+                    [makeBVI [("a","-8"),("b","-2"),("c","3")]]++testVarModifyPower08 = testVmod3  "testVarModifyPower08"+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+                    [makeBVI [("b","55"),("c","-2")]]+                    []++--  Tests for xsd_integer:eq++testVarModifyEq01, testVarModifyEq02, testVarModifyEq03,+  testVarModifyEq04, testVarModifyEq05 :: Test++testVarModifyEq01 = testVmod2  "testVarModifyEq01"+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    [makeBVI [("a","100"),("b","100")]]++testVarModifyEq02 = testVmod2  "testVarModifyEq02"+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    []++testVarModifyEq03 = testVmod2  "testVarModifyEq03"+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    []++testVarModifyEq04 = testVmod2  "testVarModifyEq04"+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyEq05 = testVmod2  "testVarModifyEq05"+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Tests for xsd_integer:ne++testVarModifyNe01, testVarModifyNe02, testVarModifyNe03,+  testVarModifyNe04, testVarModifyNe05 :: Test++testVarModifyNe01 = testVmod2  "testVarModifyNe01"+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    []++testVarModifyNe02 = testVmod2  "testVarModifyNe02"+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    [makeBVI [("a","99"),("b","100")]]++testVarModifyNe03 = testVmod2  "testVarModifyNe03"+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    [makeBVI [("a","-99"),("b","-100")]]++testVarModifyNe04 = testVmod2  "testVarModifyNe04"+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyNe05 = testVmod2  "testVarModifyNe05"+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Tests for xsd_integer:lt++testVarModifyLt01, testVarModifyLt02, testVarModifyLt03,+  testVarModifyLt04, testVarModifyLt05 :: Test++testVarModifyLt01 = testVmod2  "testVarModifyLt01"+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    []++testVarModifyLt02 = testVmod2  "testVarModifyLt02"+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    [makeBVI [("a","99"),("b","100")]]++testVarModifyLt03 = testVmod2  "testVarModifyLt03"+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    []++testVarModifyLt04 = testVmod2  "testVarModifyLt04"+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyLt05 = testVmod2  "testVarModifyLt05"+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Tests for xsd_integer:le++testVarModifyLe01, testVarModifyLe02, testVarModifyLe03,+  testVarModifyLe04, testVarModifyLe05 :: Test++testVarModifyLe01 = testVmod2  "testVarModifyLe01"+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    [makeBVI [("a","100"),("b","100")]]++testVarModifyLe02 = testVmod2  "testVarModifyLe02"+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    [makeBVI [("a","99"),("b","100")]]++testVarModifyLe03 = testVmod2  "testVarModifyLe03"+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    []++testVarModifyLe04 = testVmod2  "testVarModifyLe04"+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyLe05 = testVmod2  "testVarModifyLe05"+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Tests for xsd_integer:gt++testVarModifyGt01, testVarModifyGt02, testVarModifyGt03,+  testVarModifyGt04, testVarModifyGt05 :: Test++testVarModifyGt01 = testVmod2  "testVarModifyGt01"+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    []++testVarModifyGt02 = testVmod2  "testVarModifyGt02"+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    []++testVarModifyGt03 = testVmod2  "testVarModifyGt03"+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    [makeBVI [("a","-99"),("b","-100")]]++testVarModifyGt04 = testVmod2  "testVarModifyGt04"+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyGt05 = testVmod2  "testVarModifyGt05"+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Tests for xsd_integer:ge++testVarModifyGe01, testVarModifyGe02, testVarModifyGe03,+  testVarModifyGe04, testVarModifyGe05 :: Test++testVarModifyGe01 = testVmod2  "testVarModifyGe01"+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100"),("b","100")]]+                    [makeBVI [("a","100"),("b","100")]]++testVarModifyGe02 = testVmod2  "testVarModifyGe02"+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","99"),("b","100")]]+                    []++testVarModifyGe03 = testVmod2  "testVarModifyGe03"+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","-99"),("b","-100")]]+                    [makeBVI [("a","-99"),("b","-100")]]++testVarModifyGe04 = testVmod2  "testVarModifyGe04"+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+                    [makeBVI [("b","100")]]+                    []++testVarModifyGe05 = testVmod2  "testVarModifyGe05"+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+                    [makeBVI [("a","100")]]+                    []++--  Full suite for variable binding modifier tests++testVarModifySuite :: Test+testVarModifySuite = TestList+    [ testVarModify00+    , testVarModifyAbs01,    testVarModifyAbs02,    testVarModifyAbs03+    , testVarModifyAbs04,    testVarModifyAbs05,    testVarModifyAbs06+    , testVarModifyAbs07,    testVarModifyAbs08,    testVarModifyAbs09+    , testVarModifyAbs10+    , testVarModifyNeg01,    testVarModifyNeg02,    testVarModifyNeg03+    , testVarModifyNeg04,    testVarModifyNeg05+    , testVarModifySum01,    testVarModifySum02,    testVarModifySum03+    , testVarModifySum04,    testVarModifySum05+    , testVarModifyDiff01,   testVarModifyDiff02,   testVarModifyDiff03+    , testVarModifyDiff04,   testVarModifyDiff05+    , testVarModifyProd01,   testVarModifyProd02,   testVarModifyProd03+    , testVarModifyProd04,   testVarModifyProd05,   testVarModifyProd06+    , testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03+    , testVarModifyDivMod04, testVarModifyDivMod05, testVarModifyDivMod06+    , testVarModifyDivMod07+    , testVarModifyPower01,  testVarModifyPower02,  testVarModifyPower03+    , testVarModifyPower04,  testVarModifyPower05,  testVarModifyPower06+    , testVarModifyPower07,  testVarModifyPower08+    , testVarModifyEq01,     testVarModifyEq02,     testVarModifyEq03+    , testVarModifyEq04,     testVarModifyEq05+    , testVarModifyNe01,     testVarModifyNe02,     testVarModifyNe03+    , testVarModifyNe04,     testVarModifyNe05+    , testVarModifyLt01,     testVarModifyLt02,     testVarModifyLt03+    , testVarModifyLt04,     testVarModifyLt05+    , testVarModifyLe01,     testVarModifyLe02,     testVarModifyLe03+    , testVarModifyLe04,     testVarModifyLe05+    , testVarModifyGt01,     testVarModifyGt02,     testVarModifyGt03+    , testVarModifyGt04,     testVarModifyGt05+    , testVarModifyGe01,     testVarModifyGe02,     testVarModifyGe03+    , testVarModifyGe04,     testVarModifyGe05+    ]++------------------------------------------------------------+--  Test rules defined for datatype+------------------------------------------------------------++mkGraph :: String -> RDFGraph+mkGraph grstr = makeRDFGraphFromN3String (prefixXsdInteger++base++grstr)+    where+        base = "@prefix : <"++nsURI namespaceDefault++"> . \n"++testRuleFwd :: String -> Maybe (Rule RDFGraph) -> String -> [String] -> Test+testRuleFwd lab (Just rule) antstr constrs =+    let+        antgr  = mkGraph antstr+        congrs = map mkGraph constrs+    in+        testEqv lab congrs $ fwdApply rule [antgr]+testRuleFwd lab Nothing _ _ = TestCase $+    assertFailure $ "testRuleFwd:"++lab++", null rule supplied"++testRuleBwd :: String -> Maybe (Rule RDFGraph) -> String -> [[String]] -> Test+testRuleBwd lab (Just rule) antstr prestrss =+    let+        antgr   = mkGraph antstr+        pregrss = map (map mkGraph) prestrss+    in+        testEqvEqv lab pregrss $ bwdApply rule antgr+testRuleBwd lab Nothing _ _ = TestCase $+    assertFailure $ "testRuleBwd:"++lab++", null rule supplied"++testRuleChk :: String -> Maybe (Rule RDFGraph) -> String -> String -> Test+testRuleChk lab (Just rule) antstr constr =+    let+        antgr = mkGraph antstr+        congr = mkGraph constr+    in+        test lab $ checkInference rule [antgr] congr+testRuleChk lab Nothing _ _ = TestCase $+    assertFailure $ "testRuleChk:"++lab++", null rule supplied"++xsdIntRules :: Ruleset RDFGraph+xsdIntRules = typeRules rdfDatatypeXsdInteger++{-+axdt :: Maybe (Formula RDFGraph)+axdt        = getRulesetAxiom axiomXsdIntegerDT      xsdIntRules+-}++ruleabs, ruleneg, rulesum, rulediff, ruleprod,+  ruledivmod, rulepower, ruleeq, rulene, rulelt, rulele,+  rulegt, rulege :: Maybe (Rule RDFGraph)+ruleabs     = getRulesetRule  ruleXsdIntegerAbs      xsdIntRules+ruleneg     = getRulesetRule  ruleXsdIntegerNeg      xsdIntRules+rulesum     = getRulesetRule  ruleXsdIntegerSum      xsdIntRules+rulediff    = getRulesetRule  ruleXsdIntegerDiff     xsdIntRules+ruleprod    = getRulesetRule  ruleXsdIntegerProd     xsdIntRules+ruledivmod  = getRulesetRule  ruleXsdIntegerDivMod   xsdIntRules+rulepower   = getRulesetRule  ruleXsdIntegerPower    xsdIntRules+ruleeq      = getRulesetRule  ruleXsdIntegerEq       xsdIntRules+rulene      = getRulesetRule  ruleXsdIntegerNe       xsdIntRules+rulelt      = getRulesetRule  ruleXsdIntegerLt       xsdIntRules+rulele      = getRulesetRule  ruleXsdIntegerLe       xsdIntRules+rulegt      = getRulesetRule  ruleXsdIntegerGt       xsdIntRules+rulege      = getRulesetRule  ruleXsdIntegerGe       xsdIntRules++-- Test cases for the arithmetic functions++-- abs++abs01inp :: String+abs01inp =+        "_:a a xsd_integer:Abs ; "+    +++ "  rdf:_2 \"1\"^^xsd:integer . "+    +abs01fwd :: [String]+abs01fwd =+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]++abs01bwd :: [[String]]+abs01bwd = []++abs02inp :: String+abs02inp =+        "_:a a xsd_integer:Abs ; "+    +++ "  rdf:_2 \"-1\"^^xsd:integer . "+    +abs02fwd :: [String]+abs02fwd =+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]++abs02bwd :: [[String]]+abs02bwd =+    []++abs03inp :: String+abs03inp =+        "_:a a xsd_integer:Abs ; "+    +++ "  rdf:_1 \"1\"^^xsd:integer . "++abs03fwd :: [String]+abs03fwd = []++abs03bwd :: [[String]]+abs03bwd =+    [ [ "_:a a xsd_integer:Abs . "+      , "_:a rdf:_2 \"1\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Abs . "+      , "_:a rdf:_2 \"-1\"^^xsd:integer . "+      ]+    ]++abs04inp :: String+abs04inp =+        "_:a a xsd_integer:Abs ; "+    +++ "  rdf:_1 \"-1\"^^xsd:integer . "++abs04fwd :: [String]+abs04fwd =+    [ falseGraphStr+    ]++abs04bwd :: [[String]]+abs04bwd =+    [ [ falseGraphStr+      ]+    ]++-- neg++neg01inp :: String+neg01inp =+        "_:a a xsd_integer:Neg ; "+    +++ "  rdf:_2 \"1\"^^xsd:integer . "+    +neg01fwd :: [String]+neg01fwd =+    [ "_:a rdf:_1 \"-1\"^^xsd:integer . " ]++neg01bwd :: [[String]]+neg01bwd =+    [ [ "_:a a xsd_integer:Neg . "+      , "_:a rdf:_1 \"-1\"^^xsd:integer . "+      ]+    ]++neg02inp :: String+neg02inp =+        "_:a a xsd_integer:Neg ; "+    +++ "  rdf:_2 \"-2\"^^xsd:integer . "+    +neg02fwd :: [String]+neg02fwd =+    [ "_:a rdf:_1 \"2\"^^xsd:integer . " ]++neg02bwd :: [[String]]+neg02bwd =+    [ [ "_:a a xsd_integer:Neg . "+      , "_:a rdf:_1 \"2\"^^xsd:integer . "+      ]+    ]++-- sum++sum01inp :: String+sum01inp =+        "_:a a xsd_integer:Sum ; "+    +++ "  rdf:_2 \"31\"^^xsd:integer ; "+    +++ "  rdf:_3 \"20\"^^xsd:integer . "++sum01fwd :: [String]+sum01fwd =+    [ "_:a rdf:_1 \"51\"^^xsd:integer . " ]++sum01bwd :: [[String]]+sum01bwd =+    [ [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_1 \"51\"^^xsd:integer . "+      , "_:a rdf:_2 \"31\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_1 \"51\"^^xsd:integer . "+      , "_:a rdf:_3 \"20\"^^xsd:integer . "+      ]+    ]++sum02inp :: String+sum02inp =+        "_:a a xsd_integer:Sum ; "+    +++ "  rdf:_1 \"52\"^^xsd:integer ; "+    +++ "  rdf:_3 \"21\"^^xsd:integer . "+    +sum02fwd :: [String]    +sum02fwd =+    [ "_:a rdf:_2 \"31\"^^xsd:integer . " ]++sum02bwd :: [[String]]+sum02bwd =+    [ [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_1 \"52\"^^xsd:integer . "+      , "_:a rdf:_2 \"31\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_2 \"31\"^^xsd:integer . "+      , "_:a rdf:_3 \"21\"^^xsd:integer . "+      ]+    ]++sum03inp :: String+sum03inp =+        "_:a a xsd_integer:Sum ; "+    +++ "  rdf:_1 \"53\"^^xsd:integer ; "+    +++ "  rdf:_2 \"32\"^^xsd:integer . "++sum03fwd :: [String]+sum03fwd =+    [ "_:a rdf:_3 \"21\"^^xsd:integer . " ]++sum03bwd :: [[String]]+sum03bwd =+    [ [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_1 \"53\"^^xsd:integer . "+      , "_:a rdf:_3 \"21\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Sum . "+      , "_:a rdf:_2 \"32\"^^xsd:integer . "+      , "_:a rdf:_3 \"21\"^^xsd:integer . "+      ]+    ]++-- diff++diff01inp :: String+diff01inp =+        "_:a a xsd_integer:Diff ; "+    +++ "  rdf:_2 \"222\"^^xsd:integer ; "+    +++ "  rdf:_3 \"333\"^^xsd:integer . "+    +diff01fwd :: [String]+diff01fwd =+    [ "_:a rdf:_1 \"-111\"^^xsd:integer . " ]++diff01bwd :: [[String]]+diff01bwd =+    [ [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "+      , "_:a rdf:_3 \"333\"^^xsd:integer . "+      ]+    ]++diff02inp :: String+diff02inp =+        "_:a a xsd_integer:Diff ; "+    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "+    +++ "  rdf:_3 \"333\"^^xsd:integer . "++diff02fwd :: [String]+diff02fwd =+    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]++diff02bwd :: [[String]]+diff02bwd =+    [ [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      , "_:a rdf:_3 \"333\"^^xsd:integer . "+      ]+    ]++diff03inp :: String+diff03inp =+        "_:a a xsd_integer:Diff ; "+    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "+    +++ "  rdf:_2 \"222\"^^xsd:integer . "++diff03fwd :: [String]+diff03fwd =+    [ "_:a rdf:_3 \"333\"^^xsd:integer . " ]++diff03bwd :: [[String]]+diff03bwd =+    [ [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "+      , "_:a rdf:_3 \"333\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Diff . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      , "_:a rdf:_3 \"333\"^^xsd:integer . "+      ]+    ]++-- prod++prod01inp :: String+prod01inp =+        "_:a a xsd_integer:Prod ; "+    +++ "  rdf:_2 \"222\"^^xsd:integer ; "+    +++ "  rdf:_3 \"3\"^^xsd:integer . "++prod01fwd :: [String]+prod01fwd =+    [ "_:a rdf:_1 \"666\"^^xsd:integer . " ]++prod01bwd :: [[String]]+prod01bwd =+    [ [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_1 \"666\"^^xsd:integer . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_1 \"666\"^^xsd:integer . "+      , "_:a rdf:_3 \"3\"^^xsd:integer . "+      ]+    ]++prod02inp :: String+prod02inp =+        "_:a a xsd_integer:Prod ; "+    +++ "  rdf:_1 \"666\"^^xsd:integer ; "+    +++ "  rdf:_3 \"3\"^^xsd:integer . "++prod02fwd :: [String]+prod02fwd =+    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]++prod02bwd :: [[String]]+prod02bwd =+    [ [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_1 \"666\"^^xsd:integer . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      , "_:a rdf:_3 \"3\"^^xsd:integer . "+      ]+    ]++prod03inp :: String+prod03inp =+        "_:a a xsd_integer:Prod ; "+    +++ "  rdf:_1 \"666\"^^xsd:integer ; "+    +++ "  rdf:_2 \"222\"^^xsd:integer . "++prod03fwd :: [String]+prod03fwd =+    [ "_:a rdf:_3 \"3\"^^xsd:integer . " ]++prod03bwd :: [[String]]+prod03bwd =+    [ [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_1 \"666\"^^xsd:integer . "+      , "_:a rdf:_3 \"3\"^^xsd:integer . "+      ]+    , [ "_:a a xsd_integer:Prod . "+      , "_:a rdf:_2 \"222\"^^xsd:integer . "+      , "_:a rdf:_3 \"3\"^^xsd:integer . "+      ]+    ]++-- divmod++divmod01inp :: String+divmod01inp =+        "_:a a xsd_integer:DivMod ; "+    +++ "  rdf:_3 \"33\"^^xsd:integer ; "+    +++ "  rdf:_4 \"5\"^^xsd:integer . "++divmod01fwd :: [String]+divmod01fwd =+    [     "_:a rdf:_1 \"6\"^^xsd:integer . "+      +++ "_:a rdf:_2 \"3\"^^xsd:integer . "+    ]++divmod01bwd :: [[String]]+divmod01bwd =+    [ {- "_:a a xsd_integer:DivMod . "+      , "_:a rdf:_1 \"6\"^^xsd:integer . "+      , "_:a rdf:_2 \"3\"^^xsd:integer . "+      , "_:a rdf:_4 \"5\"^^xsd:integer . "+      -}+    ]++divmod02inp :: String+divmod02inp =+        "_:a a xsd_integer:DivMod ; "+    +++ "  rdf:_1 \"6\"^^xsd:integer ; "+    +++ "  rdf:_2 \"3\"^^xsd:integer ; "+    +++ "  rdf:_4 \"5\"^^xsd:integer . "++divmod02fwd :: [String]+divmod02fwd =+    [ ]++divmod02bwd :: [[String]]+divmod02bwd =+    [ {- "_:a a xsd_integer:DivMod . "+      , "_:a rdf:_3 \"33\"^^xsd:integer . "+      , "_:a rdf:_4 \"5\"^^xsd:integer . "+      -}+    ]++divmod03inp :: String+divmod03inp =+        "_:a a xsd_integer:DivMod ; "+    +++ "  rdf:_3 \"-33\"^^xsd:integer ; "+    +++ "  rdf:_4 \"5\"^^xsd:integer . "++divmod03fwd :: [String]+divmod03fwd =+    [     "_:a rdf:_1 \"-7\"^^xsd:integer . "+      +++ "_:a rdf:_2 \"2\"^^xsd:integer . "+    ]++divmod03bwd :: [[String]]+divmod03bwd =+    [ ]++-- power++power01inp :: String+power01inp =+        "_:a a xsd_integer:Power ; "+    +++ "  rdf:_2 \"2\"^^xsd:integer ; "+    +++ "  rdf:_3 \"5\"^^xsd:integer . "++power01fwd :: [String]+power01fwd =+    [ "_:a rdf:_1 \"32\"^^xsd:integer . " ]++power01bwd :: [[String]]+power01bwd =+    [ ]++power02inp :: String+power02inp =+        "_:a a xsd_integer:Power ; "+    +++ "  rdf:_2 \"111\"^^xsd:integer ; "+    +++ "  rdf:_3 \"0\"^^xsd:integer . "++power02fwd :: [String]+power02fwd =+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]++power02bwd :: [[String]]+power02bwd =+    [ ]++power03inp :: String+power03inp =+        "_:a a xsd_integer:Power ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer ; "+    +++ "  rdf:_3 \"-33\"^^xsd:integer . "++power03fwd :: [String]+power03fwd =+    [ falseGraphStr ]++power03bwd :: [[String]]+power03bwd =+    [ [ falseGraphStr ]+    ]++-- eq++eq01inp :: String+eq01inp =+        "_:a a xsd_integer:Eq ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++eq01fwd :: [String]+eq01fwd = [ ]++eq01bwd :: [[String]]+eq01bwd = [ ]++eq02inp :: String+eq02inp =+        "_:a a xsd_integer:Eq ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++eq02fwd :: [String]+eq02fwd = [ falseGraphStr ]++eq02bwd :: [[String]]+eq02bwd = [ [falseGraphStr] ]++eq03inp :: String+eq03inp =+        "_:a a xsd_integer:Eq ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++eq03fwd :: [String]+eq03fwd = [ falseGraphStr ]++eq03bwd :: [[String]]+eq03bwd = [ [falseGraphStr] ]++-- ne++ne01inp :: String+ne01inp =+        "_:a a xsd_integer:Ne ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++ne01fwd :: [String]+ne01fwd = [ falseGraphStr ]++ne01bwd :: [[String]]+ne01bwd = [ [falseGraphStr] ]++ne02inp :: String+ne02inp =+        "_:a a xsd_integer:Ne ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++ne02fwd :: [String]+ne02fwd = [ ]++ne02bwd :: [[String]]+ne02bwd = [ ]++ne03inp :: String+ne03inp =+        "_:a a xsd_integer:Ne ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++ne03fwd :: [String]+ne03fwd = [ ]++ne03bwd :: [[String]]+ne03bwd = [ ]++-- lt++lt01inp :: String+lt01inp =+        "_:a a xsd_integer:Lt ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++lt01fwd :: [String]+lt01fwd = [ falseGraphStr ]++lt01bwd :: [[String]]+lt01bwd = [ [falseGraphStr] ]++lt02inp :: String+lt02inp =+        "_:a a xsd_integer:Lt ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++lt02fwd :: [String]+lt02fwd = [ ]++lt02bwd :: [[String]]+lt02bwd = [ ]++lt03inp :: String+lt03inp =+        "_:a a xsd_integer:Lt ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++lt03fwd :: [String]+lt03fwd = [ falseGraphStr ]++lt03bwd :: [[String]]+lt03bwd = [ [falseGraphStr] ]++-- le++le01inp :: String+le01inp =+        "_:a a xsd_integer:Le ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++le01fwd :: [String]+le01fwd = [ ]++le01bwd :: [[String]]+le01bwd = [ ]++le02inp :: String+le02inp =+        "_:a a xsd_integer:Le ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++le02fwd :: [String]+le02fwd = [ ]++le02bwd :: [[String]]+le02bwd = [ ]++le03inp :: String+le03inp =+        "_:a a xsd_integer:Le ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++le03fwd :: [String]+le03fwd = [ falseGraphStr ]++le03bwd :: [[String]]+le03bwd = [ [falseGraphStr] ]++-- gt++gt01inp :: String+gt01inp =+        "_:a a xsd_integer:Gt ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++gt01fwd :: [String]+gt01fwd = [ falseGraphStr ]++gt01bwd :: [[String]]+gt01bwd = [ [falseGraphStr] ]++gt02inp :: String+gt02inp =+        "_:a a xsd_integer:Gt ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++gt02fwd :: [String]+gt02fwd = [ falseGraphStr ]++gt02bwd :: [[String]]+gt02bwd = [ [falseGraphStr] ]++gt03inp :: String+gt03inp =+        "_:a a xsd_integer:Gt ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++gt03fwd :: [String]+gt03fwd = [ ]++gt03bwd :: [[String]]+gt03bwd = [ ]++-- ge++ge01inp :: String+ge01inp =+        "_:a a xsd_integer:Ge ; "+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "+    +++ "  rdf:_2 \"11\"^^xsd:integer . "++ge01fwd :: [String]+ge01fwd = [ ]++ge01bwd :: [[String]]+ge01bwd = [ ]++ge02inp :: String+ge02inp =+        "_:a a xsd_integer:Ge ; "+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "+    +++ "  rdf:_2 \"22\"^^xsd:integer . "++ge02fwd :: [String]+ge02fwd = [ falseGraphStr ]++ge02bwd :: [[String]]+ge02bwd = [ [falseGraphStr] ]++ge03inp :: String+ge03inp =+        "_:a a xsd_integer:Ge ; "+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "++ge03fwd :: [String]+ge03fwd = [ ]++ge03bwd :: [[String]]+ge03bwd = [ ]++-- Test cases from design notes++infixr 5 ++++(+++) :: String -> ShowS+(+++) str = ((str++"\n")++)++-- Make a vector of rules using the graph string below++pvRules :: [RDFRule]+-- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr+pvRules = typeMkRules rdfDatatypeXsdInteger gr+    where+        gr = (mkGraph pvRulesStr)++pvRulesStr :: String+pvRulesStr =+        ":PassengerVehicle a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "+    +++ "  rdfd:constraint xsd_integer:sum . "+    +++ ":PassengerVehicle1 a rdfd:GeneralRestriction ; "+    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "+    +++ "  rdfd:constraint xsd_integer:sum ; "+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "++--  Now the test cases that use the rules created above.++pvRule0, pvRule1 :: Maybe (Rule RDFGraph)+pvRule0 = mapFindMaybe+            (ScopedName namespaceDefault "PassengerVehicle")+            (LookupMap pvRules)+pvRule1 = mapFindMaybe+            (ScopedName namespaceDefault "PassengerVehicle1")+            (LookupMap pvRules)++pv01inp :: String+pv01inp =+        "_:a a :PassengerVehicle ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :standingCapacity \"20\"^^xsd:integer . "++pv01fwd :: [String]+pv01fwd =+    [ "_:a :totalCapacity \"50\"^^xsd:integer . " ]++pv01bwd :: [[String]]+pv01bwd =+    [ [ "_:a a :PassengerVehicle . "+      , "_:a :totalCapacity \"50\"^^xsd:integer . "+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "+      ]+    , [ "_:a a :PassengerVehicle . "+      , "_:a :totalCapacity \"50\"^^xsd:integer . "+      , "_:a :standingCapacity \"20\"^^xsd:integer . "+      ]+    ]++pv02inp :: String+pv02inp =+        "_:a a :PassengerVehicle ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :totalCapacity \"51\"^^xsd:integer . "+    +++ "_:b a :PassengerVehicle ; "+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "+    +++ "  :totalCapacity \"52\"^^xsd:integer . "++pv02fwd :: [String]+pv02fwd =+    [ "_:a :standingCapacity \"21\"^^xsd:integer . "+    , "_:b :seatedCapacity \"32\"^^xsd:integer . "+    ]++pv02bwd :: [[String]]+pv02bwd =+    [ [ "_:a a :PassengerVehicle . "+      , "_:a :standingCapacity \"21\"^^xsd:integer . "+      , "_:a :totalCapacity \"51\"^^xsd:integer . "+      , "_:b a :PassengerVehicle . "+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "+      , "_:b :totalCapacity \"52\"^^xsd:integer . "+      ]+    , [ "_:a a :PassengerVehicle . "+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "+      , "_:a :standingCapacity \"21\"^^xsd:integer . "+      , "_:b a :PassengerVehicle . "+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "+      , "_:b :totalCapacity \"52\"^^xsd:integer . "+      ]+    , [ "_:a a :PassengerVehicle . "+      , "_:a :standingCapacity \"21\"^^xsd:integer . "+      , "_:a :totalCapacity \"51\"^^xsd:integer . "+      , "_:b a :PassengerVehicle . "+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "+      , "_:b :standingCapacity \"20\"^^xsd:integer . "+      ]+    , [ "_:a a :PassengerVehicle . "+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "+      , "_:a :standingCapacity \"21\"^^xsd:integer . "+      , "_:b a :PassengerVehicle . "+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "+      , "_:b :standingCapacity \"20\"^^xsd:integer . "+      ]+    ]++pv03inp :: String+pv03inp =+        "_:a a :PassengerVehicle ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :standingCapacity \"23\"^^xsd:integer ; "+    +++ "  :totalCapacity \"53\"^^xsd:integer . "++pv03fwd :: [String]+pv03fwd = []++pv04inp :: String+pv04inp =+        "_:a a :PassengerVehicle ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "+    +++ "  :totalCapacity \"54\"^^xsd:integer . "++pv04fwd :: [String]+pv04fwd =+    [     "_:a :standingCapacity \"24\"^^xsd:integer . "+      +++ "_:a :seatedCapacity \"34\"^^xsd:integer . "+      +++ "_:a :totalCapacity \"50\"^^xsd:integer . "+    ]++pv05inp :: String+pv05inp =+        "_:a a :PassengerVehicle1 ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :standingCapacity \"25\"^^xsd:integer ; "+    +++ "  :totalCapacity \"55\"^^xsd:integer . "++pv05fwd :: [String]+pv05fwd = []++pv06inp :: String+pv06inp =+        "_:a a :PassengerVehicle1 ; "+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "+    +++ "  :totalCapacity \"56\"^^xsd:integer . "++pv06fwd :: [String]+pv06fwd =+    [ falseGraphStr+    ]++pv06bwd :: [[String]]+pv06bwd =+    [ [ falseGraphStr+      ]+    ]++pv07inp :: String+pv07inp =+        "_:a a :PassengerVehicle ; "+    +++ "  :totalCapacity \"57\"^^xsd:integer . "++pv07fwd :: [String]+pv07fwd = []++-- how come this isn't [[String]] ?+pv07bwd :: [String]+pv07bwd = []++--  Full suite for datatype rule tests++testDatatypeRuleSuite :: Test+testDatatypeRuleSuite = TestList+  [ testRuleFwd "testRuleFwdAbs01" ruleabs abs01inp abs01fwd+  , testRuleFwd "testRuleFwdAbs02" ruleabs abs02inp abs02fwd+  , testRuleFwd "testRuleFwdAbs03" ruleabs abs03inp abs03fwd+  , testRuleFwd "testRuleFwdAbs04" ruleabs abs04inp abs04fwd+  , testRuleFwd "testRuleFwdNeg01" ruleneg neg01inp neg01fwd+  , testRuleFwd "testRuleFwdNeg02" ruleneg neg02inp neg02fwd+  , testRuleFwd "testRuleFwdSum01" rulesum sum01inp sum01fwd+  , testRuleFwd "testRuleFwdSum02" rulesum sum02inp sum02fwd+  , testRuleFwd "testRuleFwdSum03" rulesum sum03inp sum03fwd+  , testRuleFwd "testRuleFwdDiff01" rulediff diff01inp diff01fwd+  , testRuleFwd "testRuleFwdDiff02" rulediff diff02inp diff02fwd+  , testRuleFwd "testRuleFwdDiff03" rulediff diff03inp diff03fwd+  , testRuleFwd "testRuleFwdProd01" ruleprod prod01inp prod01fwd+  , testRuleFwd "testRuleFwdProd02" ruleprod prod02inp prod02fwd+  , testRuleFwd "testRuleFwdProd03" ruleprod prod03inp prod03fwd+  , testRuleFwd "testRuleFwdDivMod01" ruledivmod divmod01inp divmod01fwd+  , testRuleFwd "testRuleFwdDivMod02" ruledivmod divmod02inp divmod02fwd+  , testRuleFwd "testRuleFwdDivMod03" ruledivmod divmod03inp divmod03fwd+  , testRuleFwd "testRuleFwdPower01" rulepower power01inp power01fwd+  , testRuleFwd "testRuleFwdPower02" rulepower power02inp power02fwd+  , testRuleFwd "testRuleFwdPower03" rulepower power03inp power03fwd+  , testRuleFwd "testRuleFwdEq01" ruleeq eq01inp eq01fwd+  , testRuleFwd "testRuleFwdEq02" ruleeq eq02inp eq02fwd+  , testRuleFwd "testRuleFwdEq03" ruleeq eq03inp eq03fwd+  , testRuleFwd "testRuleFwdNe01" rulene ne01inp ne01fwd+  , testRuleFwd "testRuleFwdNe02" rulene ne02inp ne02fwd+  , testRuleFwd "testRuleFwdNe03" rulene ne03inp ne03fwd+  , testRuleFwd "testRuleFwdLt01" rulelt lt01inp lt01fwd+  , testRuleFwd "testRuleFwdLt02" rulelt lt02inp lt02fwd+  , testRuleFwd "testRuleFwdLt03" rulelt lt03inp lt03fwd+  , testRuleFwd "testRuleFwdLe01" rulele le01inp le01fwd+  , testRuleFwd "testRuleFwdLe02" rulele le02inp le02fwd+  , testRuleFwd "testRuleFwdLe03" rulele le03inp le03fwd+  , testRuleFwd "testRuleFwdGt01" rulegt gt01inp gt01fwd+  , testRuleFwd "testRuleFwdGt02" rulegt gt02inp gt02fwd+  , testRuleFwd "testRuleFwdGt03" rulegt gt03inp gt03fwd+  , testRuleFwd "testRuleFwdGe01" rulege ge01inp ge01fwd+  , testRuleFwd "testRuleFwdGe02" rulege ge02inp ge02fwd+  , testRuleFwd "testRuleFwdGe03" rulege ge03inp ge03fwd+                                      +    -- backard chaining tests+  , testRuleBwd "testRuleBwdAbs01" ruleabs abs01inp abs01bwd+  , testRuleBwd "testRuleBwdAbs02" ruleabs abs02inp abs02bwd+  , testRuleBwd "testRuleBwdAbs03" ruleabs abs03inp abs03bwd+  , testRuleBwd "testRuleBwdAbs04" ruleabs abs04inp abs04bwd+  , testRuleBwd "testRuleBwdNeg01" ruleneg neg01inp neg01bwd+  , testRuleBwd "testRuleBwdNeg02" ruleneg neg02inp neg02bwd+  , testRuleBwd "testRuleBwdSum01" rulesum sum01inp sum01bwd+  , testRuleBwd "testRuleBwdSum02" rulesum sum02inp sum02bwd+  , testRuleBwd "testRuleBwdSum03" rulesum sum03inp sum03bwd+  , testRuleBwd "testRuleBwdDiff01" rulediff diff01inp diff01bwd+  , testRuleBwd "testRuleBwdDiff02" rulediff diff02inp diff02bwd+  , testRuleBwd "testRuleBwdDiff03" rulediff diff03inp diff03bwd+  , testRuleBwd "testRuleBwdProd01" ruleprod prod01inp prod01bwd+  , testRuleBwd "testRuleBwdProd02" ruleprod prod02inp prod02bwd+  , testRuleBwd "testRuleBwdProd03" ruleprod prod03inp prod03bwd+  , testRuleBwd "testRuleBwdDivMod01" ruledivmod divmod01inp divmod01bwd+  , testRuleBwd "testRuleBwdDivMod02" ruledivmod divmod02inp divmod02bwd+  , testRuleBwd "testRuleBwdDivMod03" ruledivmod divmod03inp divmod03bwd+  , testRuleBwd "testRuleBwdPower01" rulepower power01inp power01bwd+  , testRuleBwd "testRuleBwdPower02" rulepower power02inp power02bwd+  , testRuleBwd "testRuleBwdPower03" rulepower power03inp power03bwd+  , testRuleBwd "testRuleBwdEq01" ruleeq eq01inp eq01bwd+  , testRuleBwd "testRuleBwdEq02" ruleeq eq02inp eq02bwd+  , testRuleBwd "testRuleBwdEq03" ruleeq eq03inp eq03bwd+  , testRuleBwd "testRuleBwdNe01" rulene ne01inp ne01bwd+  , testRuleBwd "testRuleBwdNe02" rulene ne02inp ne02bwd+  , testRuleBwd "testRuleBwdNe03" rulene ne03inp ne03bwd+  , testRuleBwd "testRuleBwdLt01" rulelt lt01inp lt01bwd+  , testRuleBwd "testRuleBwdLt02" rulelt lt02inp lt02bwd+  , testRuleBwd "testRuleBwdLt03" rulelt lt03inp lt03bwd+  , testRuleBwd "testRuleBwdLe01" rulele le01inp le01bwd+  , testRuleBwd "testRuleBwdLe02" rulele le02inp le02bwd+  , testRuleBwd "testRuleBwdLe03" rulele le03inp le03bwd+  , testRuleBwd "testRuleBwdGt01" rulegt gt01inp gt01bwd+  , testRuleBwd "testRuleBwdGt02" rulegt gt02inp gt02bwd+  , testRuleBwd "testRuleBwdGt03" rulegt gt03inp gt03bwd+  , testRuleBwd "testRuleBwdGe01" rulege ge01inp ge01bwd+  , testRuleBwd "testRuleBwdGe02" rulege ge02inp ge02bwd+  , testRuleBwd "testRuleBwdGe03" rulege ge03inp ge03bwd++    -- test cases from design notes+  , testRuleFwd "testRuleFwdPv01" pvRule0 pv01inp pv01fwd+  , testRuleFwd "testRuleFwdPv02" pvRule0 pv02inp pv02fwd+  , testRuleFwd "testRuleFwdPv03" pvRule0 pv03inp pv03fwd+  , testRuleFwd "testRuleFwdPv04" pvRule0 pv04inp pv04fwd+  , testRuleFwd "testRuleFwdPv05" pvRule1 pv05inp pv05fwd+  , testRuleFwd "testRuleFwdPv06" pvRule1 pv06inp pv06fwd+  , testRuleFwd "testRuleFwdPv07" pvRule0 pv07inp pv07fwd++  , testRuleBwd "testRuleBwdPv01" pvRule0 pv01inp pv01bwd+  , testRuleBwd "testRuleBwdPv02" pvRule0 pv02inp pv02bwd+  , testRuleBwd "testRuleBwdPv06" pvRule1 pv06inp pv06bwd+  , testRuleFwd "testRuleBwdPv07" pvRule0 pv07inp pv07bwd+    +  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+    [ testDatatypeSuite+    , testDatatypeValSuite+    , testVarModifySuite+    , testDatatypeRuleSuite+    ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+trules = runTestTT testDatatypeRuleSuite++runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFGraphTest.hs view
@@ -0,0 +1,1227 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFGraphTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for module RDFGraph.+--+--------------------------------------------------------------------------------++module Main where++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , mapFindMaybe )++import Swish.Utils.ListHelpers+    ( equiv )++import Swish.RDF.GraphClass+    ( Label(..), Arc, arc )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    , nullScopedName+    , makeUriScopedName+    )++import Swish.RDF.RDFGraph+    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral+    , isDatatyped, isMemberProp+    , isUri, isBlank, isQueryVar, makeBlank+    , getScopedName+    , LookupFormula(..), FormulaMap, emptyFormulaMap+    , getArcs, addArc, merge+    , remapLabels, remapLabelList+    , setFormulae, getFormulae, setFormula, getFormula+    , newNode, newNodes )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , langName +    , rdf_XMLLiteral+    )++import qualified Data.Traversable as T++import Data.List+    ( elemIndex )++import Data.Maybe+    ( fromJust )++import Test.HUnit+    ( Test(TestCase,TestList,TestLabel)+    , assertBool, assertEqual, assertString+    , runTestTT )++------------------------------------------------------------+--  Common definitions+------------------------------------------------------------++testCompare :: (Eq a, Show a) => String -> String -> a -> a -> Test+testCompare typ lab a1 a2 =+    TestCase ( assertEqual (typ++lab) a1 a2 )++testCompareEq :: (Eq a, Show a) => String -> String -> Bool -> a -> a -> Test+testCompareEq typ lab eq a1 a2 =+    TestCase ( assertEqual (typ++lab) eq (a1==a2) )++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq = testCompare "testEq"++------------------------------------------------------------+--  Test language tag comparisons+------------------------------------------------------------++type Lang = Maybe ScopedName++lt0, lt1, lt2, lt3, lt4, lt5, lt6,+  lt7, lt8 :: Lang+lt0 = Nothing+lt1 = Just (langName "en")+lt2 = Just (langName "EN")+lt3 = Just (langName "fr")+lt4 = Just (langName "FR")+lt5 = Just (langName "en-us")+lt6 = Just (langName "en-US")+lt7 = Just (langName "EN-us")+lt8 = Just (langName "EN-US")++langlist :: [(String, Lang)]+langlist =+  [ ("lt0",lt0),+    ("lt1",lt1), ("lt2",lt2), ("lt3",lt3), ("lt4",lt4),+    ("lt5",lt5), ("lt6",lt6), ("lt7",lt7), ("lt8",lt8) ]++langeqlist :: [(String, String)]+langeqlist =+  [+    ("lt1","lt2"),+    ("lt3","lt4"),+    ("lt5","lt6"),+    ("lt5","lt7"),+    ("lt5","lt8"),+    ("lt6","lt7"),+    ("lt6","lt8"),+    ("lt7","lt8")+  ]++testLangEq :: String -> Bool -> Lang -> Lang -> Test+testLangEq = testCompareEq "testLangEq:"++testLangEqSuite :: Test+testLangEqSuite = TestList+  [ testLangEq (tLab ll1 ll2) (tEq  ll1 ll2) t1 t2+      | (ll1,t1) <- langlist , (ll2,t2) <- langlist ]+    where+    tLab ll1 ll2 = ll1 ++ "-" ++ ll2+    tEq  ll1 ll2 = (ll1 == ll2)        ||+         (ll1,ll2) `elem` langeqlist ||+         (ll2,ll1) `elem` langeqlist++------------------------------------------------------------+--  Define some common values+------------------------------------------------------------++base1, base2, base3, base4 :: Namespace+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"++qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: ScopedName+qb1s1 = ScopedName base1 "s1"+qb2s2 = ScopedName base2 "s2"+qb3s3 = ScopedName base3 "s3"+qb3   = ScopedName base3 ""+qb3bm = ScopedName base3 "basemore"+qb4m  = ScopedName base4 "more"++s1, s2, s3, s4, s5, s6, s7, s8 :: RDFLabel+s1 = Res qb1s1 +s2 = Res qb2s2 +s3 = Res qb3s3 +s4 = Res qb3   +s5 = Blank "s5"+s6 = Res qb3bm +s7 = Res qb4m  +s8 = Blank "s8"++st1, st2, st3 :: RDFLabel+st1 = Res $ ScopedName base1 "st1"+st2 = Res $ ScopedName base2 "st2" +st3 = Res $ ScopedName base3 "st3"++bb, bb0, b1, b2, b3, b4, b5, b6, b7,+  b8, b9, b10 :: RDFLabel+bb  = Blank "bb" +bb0 = Blank "bb0"+b1  = Blank "b1" +b2  = Blank "b2" +b3  = Blank "b3" +b4  = Blank "b4" +b5  = Blank "b5" +b6  = Blank "b6" +b7  = Blank "b7" +b8  = Blank "b8" +b9  = Blank "b9" +b10 = Blank "b10"++c1, c2, c3, c4 :: RDFLabel+c1 = Blank "c1"+c2 = Blank "c2"+c3 = Blank "c3"+c4 = Blank "c4"++ba1, ba2, ba3, ba4 :: RDFLabel+ba1 = Blank "_1"+ba2 = Blank "_2"+ba3 = Blank "_3"+ba4 = Blank "_4"++bn3, bn4, bn5, bn6 :: RDFLabel+bn3 = Blank "3"+bn4 = Blank "4"+bn5 = Blank "5"+bn6 = Blank "6"++p1, p2, p3, p4 :: RDFLabel+p1 = Res $ ScopedName base1 "p1"+p2 = Res $ ScopedName base2 "p2"+p3 = Res $ ScopedName base3 "p3"+p4 = Res $ ScopedName base3 "p4"++o1, o2, o3, o4, o5, o6 :: RDFLabel+o1 = Res $ ScopedName base1 "o1"+o2 = Res $ ScopedName base2 "o2"+o3 = Res $ ScopedName base3 "o3"+o4 = Res qb3   +o5 = Blank "o5"+o6 = Blank "s5"++qb1t1, qb1t2 :: ScopedName+qb1t1 = ScopedName base1 "type1"+qb1t2 = ScopedName base1 "type2"++l1, l2, l3, l4, l5, l6, l7, l8,+  l9, l10, l11, l12 :: RDFLabel+l1  = Lit "l1"  Nothing                +l2  = Lit "l2"  (Just (langName "en")) +l3  = Lit "l2"  (Just (langName "fr")) +l4  = Lit "l4"  (Just qb1t1)           +l5  = Lit "l4"  (Just qb1t1)           +l6  = Lit "l4"  (Just qb1t1)           +l7  = Lit "l4"  (Just qb1t2)           +l8  = Lit "l4"  (Just qb1t2)           +l9  = Lit "l4"  (Just qb1t2)           +l10 = Lit "l10" (Just rdf_XMLLiteral)  +l11 = Lit "l10" (Just rdf_XMLLiteral)  +l12 = Lit "l10" (Just rdf_XMLLiteral)  ++v1, v2, v3, v4, vb3, vb4 :: RDFLabel+v1  = Var "v1"  +v2  = Var "v2"  +v3  = Var "v3"  +v4  = Var "v4"  +vb3 = Blank "v3"+vb4 = Blank "v4"++-- Test cases for isMemberProp++cm1, cm2, nm1, nm2 :: RDFLabel+cm1  = Res $ ScopedName namespaceRDF "_1"+cm2  = Res $ ScopedName namespaceRDF "_234567"+nm1  = Res $ ScopedName namespaceRDF "987"+nm2  = Res $ ScopedName namespaceRDF "_987a65"++------------------------------------------------------------+--  RDFLabel construction and equality tests+------------------------------------------------------------++testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test+testLabelEq = testCompareEq "testLabelEq:"++nodelist :: [(String, RDFLabel)]+nodelist =+  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5)+  , ("s6",s6), ("s7",s7), ("s8",s8)+  , ("b1",b1), ("b2",b2), ("b3",b3), ("b4",b4)+  , ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4)+  , ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4), ("o5",o5)+  , ("l1",l1), ("l2",l2), ("l3",l3)+  , ("l4",l4), ("l5",l5), ("l6",l6)+  , ("l7",l7), ("l8",l8), ("l9",l9)+  , ("l10",l10), ("l11",l11), ("l12",l12)+  , ("v1",v1), ("v2",v2)+  ]++nodeeqlist :: [(String, String)]+nodeeqlist =+  [ ("s4","o4")+  , ("s5","o6")+  , ("s6","s7")+  , ("l4","l5")+  , ("l4","l6")+  , ("l5","l6")+  , ("l7","l8")+  , ("l7","l9")+  , ("l8","l9")+  , ("l10","l11")+  , ("l10","l12")+  , ("l11","l12")+  ]++testNodeEqSuite :: Test+testNodeEqSuite = TestList+  [ testLabelEq (tLab ll1 ll2) (tEq  ll1 ll2) n1 n2+      | (ll1,n1) <- nodelist , (ll2,n2) <- nodelist ]+    where+    tLab ll1 ll2 = ll1 ++ "-" ++ ll2+    tEq  ll1 ll2 = (ll1 == ll2)        ||+         (ll1,ll2) `elem` nodeeqlist ||+         (ll2,ll1) `elem` nodeeqlist++------------------------------------------------------------+--  RDFLabel classification tests+------------------------------------------------------------++testClass :: String -> (RDFLabel -> Bool) -> RDFLabel -> Bool -> Test+testClass lab clsf nod eq = testCompare "testClass:" lab eq (clsf nod)++altIsXmlLit :: RDFLabel -> Bool+altIsXmlLit = isDatatyped rdf_XMLLiteral++testNodeClassSuite :: Test+testNodeClassSuite = TestList+  [ testClass "testClass01" isUri            s1  True+  , testClass "testClass02" isUri            s5  False+  , testClass "testClass03" isUri            ba1 False+  , testClass "testClass04" isUri            l1  False+  , testClass "testClass05" isUri            l10 False+  , testClass "testClass06" isUri            cm1 True+  , testClass "testClass07" isUri            nm1 True+  , testClass "testClass08" isUri            v1  False++  , testClass "testClass10" isLiteral        s1  False+  , testClass "testClass11" isLiteral        s5  False+  , testClass "testClass12" isLiteral        ba1 False+  , testClass "testClass13" isLiteral        l1  True+  , testClass "testClass14" isLiteral        l4  True+  , testClass "testClass15" isLiteral        l5  True+  , testClass "testClass16" isLiteral        l10 True+  , testClass "testClass17" isLiteral        l11 True+  , testClass "testClass18" isLiteral        cm1 False+  , testClass "testClass19" isLiteral        v1  False++  , testClass "testClass20" isTypedLiteral   s1  False+  , testClass "testClass21" isTypedLiteral   s5  False+  , testClass "testClass22" isTypedLiteral   ba1 False+  , testClass "testClass23" isTypedLiteral   l1  False+  , testClass "testClass24" isTypedLiteral   l2  False+  , testClass "testClass25" isTypedLiteral   l4  True+  , testClass "testClass26" isTypedLiteral   l5  True+  , testClass "testClass27" isTypedLiteral   l10 True+  , testClass "testClass28" isTypedLiteral   l11 True+  , testClass "testClass29" isTypedLiteral   v1  False++  , testClass "testClass30" isUntypedLiteral s1  False+  , testClass "testClass31" isUntypedLiteral s5  False+  , testClass "testClass32" isUntypedLiteral ba1 False+  , testClass "testClass33" isUntypedLiteral l1  True+  , testClass "testClass34" isUntypedLiteral l2  True+  , testClass "testClass35" isUntypedLiteral l4  False+  , testClass "testClass36" isUntypedLiteral l5  False+  , testClass "testClass37" isUntypedLiteral l10 False+  , testClass "testClass38" isUntypedLiteral l11 False+  , testClass "testClass39" isUntypedLiteral v1  False++  , testClass "testClass40" isXMLLiteral     s1  False+  , testClass "testClass41" isXMLLiteral     s5  False+  , testClass "testClass42" isXMLLiteral     ba1 False+  , testClass "testClass43" isXMLLiteral     l1  False+  , testClass "testClass44" isXMLLiteral     l2  False+  , testClass "testClass45" isXMLLiteral     l4  False+  , testClass "testClass46" isXMLLiteral     l5  False+  , testClass "testClass47" isXMLLiteral     l10 True+  , testClass "testClass48" isXMLLiteral     l11 True+  , testClass "testClass49" isXMLLiteral     v1  False++  , testClass "testClass50" altIsXmlLit      s1  False+  , testClass "testClass51" altIsXmlLit      s5  False+  , testClass "testClass52" altIsXmlLit      ba1 False+  , testClass "testClass53" altIsXmlLit      l1  False+  , testClass "testClass54" altIsXmlLit      l2  False+  , testClass "testClass55" altIsXmlLit      l4  False+  , testClass "testClass56" altIsXmlLit      l5  False+  , testClass "testClass57" altIsXmlLit      l10 True+  , testClass "testClass58" altIsXmlLit      l11 True++  , testClass "testClass60" isMemberProp     s1  False+  , testClass "testClass61" isMemberProp     s5  False+  , testClass "testClass62" isMemberProp     ba1 False+  , testClass "testClass63" isMemberProp     l1  False+  , testClass "testClass64" isMemberProp     l10 False+  , testClass "testClass65" isMemberProp     cm1 True+  , testClass "testClass66" isMemberProp     cm2 True+  , testClass "testClass67" isMemberProp     nm1 False+  , testClass "testClass68" isMemberProp     nm2 False++  , testClass "testClass70" isBlank          s7  False+  , testClass "testClass71" isBlank          s5  True+  , testClass "testClass72" isBlank          ba1 True+  , testClass "testClass73" isBlank          l1  False+  , testClass "testClass74" isBlank          l4  False+  , testClass "testClass75" isBlank          l5  False+  , testClass "testClass76" isBlank          l10 False+  , testClass "testClass77" isBlank          l11 False+  , testClass "testClass78" isBlank          cm1 False+  , testClass "testClass79" isBlank          v1  False++  , testClass "testClass80" isQueryVar       s8  False+  , testClass "testClass81" isQueryVar       s5  False+  , testClass "testClass82" isQueryVar       ba1 False+  , testClass "testClass83" isQueryVar       l1  False+  , testClass "testClass84" isQueryVar       l4  False+  , testClass "testClass85" isQueryVar       l5  False+  , testClass "testClass86" isQueryVar       l10 False+  , testClass "testClass87" isQueryVar       l11 False+  , testClass "testClass88" isQueryVar       cm1 False+  , testClass "testClass89" isQueryVar       v1  True+    +  ]++------------------------------------------------------------+--  RDFLabel local part separation and recombination tests+------------------------------------------------------------++testLocalEq :: String -> String -> String -> Test+testLocalEq = testCompare "testLocalEq:"++testLocalLabEq :: String -> RDFLabel -> RDFLabel -> Test+testLocalLabEq = testCompare "testLocalEq:"++testNodeLocalSuite :: Test+testNodeLocalSuite = TestList+  [ testLocalEq    "01" "b1"  (getLocal b1)+  , testLocalEq    "02" "b2"  (getLocal b2)+  , testLocalEq    "03" "?v1" (getLocal v1)+  , testLocalEq    "04" "?v2" (getLocal v2)+  , testLocalLabEq "05" b1    (makeLabel "b1")+  , testLocalLabEq "06" b2    (makeLabel "b2")+  , testLocalLabEq "07" v1    (makeLabel "?v1")+  , testLocalLabEq "08" v2    (makeLabel "?v2")+  ] +  +------------------------------------------------------------+--  Node generation tests+------------------------------------------------------------++testNodeEq :: String -> RDFLabel -> RDFLabel -> Test+testNodeEq = testCompare "testNodeEq:"++tnn01, tnn02, tnn03, tnn04, tnn05, tnn06,+  tnn07, tnn08, tnn09 :: RDFLabel+tnn01 = (newNode  v1 [b1,b3,v1,v2])+tnn02 = (newNode  b1 [b1,b3,v1,v2])+tnn03 = (newNodes b1 [b1,b3,v1,v2])!!0+tnn04 = (newNodes b1 [b1,b3,v1,v2])!!1+tnn05 = (newNodes b1 [b1,b3,v1,v2])!!2+tnn06 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!0+tnn07 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!1+tnn08 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!2+tnn09 = (newNodes l1 [b1,b3,v1,v2,tnns3])!!2++tnns1, tnns2, tnns3, tnns4, tnnl1 :: RDFLabel+tnns1 = Blank "Res_s1"+tnns2 = Blank "Res_s2"+tnns3 = Blank "Res_s3"+tnns4 = Blank "Res_s4"+tnnl1 = Blank "Lit_2"++testNewNodeSuite :: Test+testNewNodeSuite = TestList+  [ testNodeEq "testNewNode01" v3    tnn01+  , testNodeEq "testNewNode02" b2    tnn02+  , testNodeEq "testNewNode03" b2    tnn03+  , testNodeEq "testNewNode04" b4    tnn04+  , testNodeEq "testNewNode05" b5    tnn05+  , testNodeEq "testNewNode06" tnns1 tnn06+  , testNodeEq "testNewNode07" tnns2 tnn07+  , testNodeEq "testNewNode08" tnns4 tnn08+  , testNodeEq "testNewNode09" tnnl1 tnn09+  ]++------------------------------------------------------------+--  RDFLabel ordering tests+------------------------------------------------------------++testLabelOrd :: String -> Ordering -> RDFLabel -> RDFLabel -> Test+testLabelOrd lab order n1 n2 =+    TestCase ( assertEqual+               ("testLabelOrd:"++lab++"["++(show n1)++","++(show n2)++"]")+               order (compare n1 n2) )++nodeorder :: [String]+nodeorder =+  -- literals+  [ "l1"+  , "l11", "l12", "l10"+  , "l2", "l3"+  , "l5", "l6", "l4", "l8", "l9", "l7"+  -- variables+  , "v1", "v2"+  -- URIs+  , "o1", "p1", "s1"+  , "o2", "p2", "s2"+  , "s4", "o4", "s6", "s7"+  , "o3", "p3", "p4", "s3"+  -- blank nodes+  , "b1", "b2", "b3", "b4"+  , "o5", "s5", "s8"+  ]++testNodeOrdSuite :: Test+testNodeOrdSuite = TestList+  [ testLabelOrd (tLab ll1 ll2) (tOrd ll1 ll2) n1 n2+      | (ll1,n1) <- nodelist , (ll2,n2) <- nodelist ]+    where+    tLab ll1 ll2 = ll1 ++ "-" ++ ll2+    tOrd ll1 ll2+      | tEq ll1 ll2  = EQ+      | otherwise    = compare (fromJust $ elemIndex ll1 nodeorder)+                               (fromJust $ elemIndex ll2 nodeorder)+    tEq  ll1 ll2 = (ll1 == ll2)        ||+           (ll1,ll2) `elem` nodeeqlist ||+           (ll2,ll1) `elem` nodeeqlist++------------------------------------------------------------+--  Other RDFLabel tests+------------------------------------------------------------++testLabelOtherSuite :: Test+testLabelOtherSuite = TestList+    [ testEq "testLabelName01" (getScopedName s1) qb1s1+    , testEq "testLabelName02" (getScopedName b1) nullScopedName+    , testEq "testLabelName03" (getScopedName l1) nullScopedName+    , testEq "testLabelName04" (getScopedName v1) nullScopedName+    ]++------------------------------------------------------------+--  Statement construction and equality tests+------------------------------------------------------------++testStmtEq :: String -> Bool -> RDFTriple -> RDFTriple -> Test+testStmtEq = testCompareEq "testStmtEq:"++slist, plist, olist :: [(String, RDFLabel)]+slist =+  [+    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)+  ]++plist =+  [+    ("p1",p1)+  ]++olist =+  [ ("o1",o1), ("o4",o4), ("o5",o5),+    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)+  ]++tlist :: [(String, Arc RDFLabel)]+tlist =+  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]+    where+    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o+    trp (_,s) (_,p) (_,o) = arc s p o++stmteqlist :: [(String, String)]+stmteqlist =+  [+    ("s6.p1.l1", "s7.p1.l1"),+    ("s6.p1.l4", "s7.p1.l4"),+    ("s6.p1.l7", "s7.p1.l7"),+    ("s6.p1.l7", "s7.p1.l8"),+    ("s6.p1.l8", "s7.p1.l7"),+    ("s6.p1.l8", "s7.p1.l8"),+    ("s6.p1.l10","s7.p1.l10"),+    ("s6.p1.o1", "s7.p1.o1"),+    ("s6.p1.o4", "s7.p1.o4"),+    ("s6.p1.o5", "s7.p1.o5"),+    ("s1.p1.l7", "s1.p1.l8"),+    ("s4.p1.l7", "s4.p1.l8"),+    ("s5.p1.l7", "s5.p1.l8"),+    ("s6.p1.l7", "s6.p1.l8"),+    ("s7.p1.l7", "s7.p1.l8")+  ]++testStmtEqSuite :: Test+testStmtEqSuite = TestList+  [ testStmtEq (tLab ll1 ll2) (tEq  ll1 ll2) t1 t2+      | (ll1,t1) <- tlist , (ll2,t2) <- tlist ]+    where+    tLab ll1 ll2 = ll1 ++ "-" ++ ll2+    tEq  ll1 ll2 = (ll1 == ll2)        ||+            (ll1,ll2) `elem` stmteqlist ||+            (ll2,ll1) `elem` stmteqlist++------------------------------------------------------------+--  Graph construction and equality tests+------------------------------------------------------------++testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test+testGraphEq lab eq gg1 gg2 =+    --  Set test False to get extra trace info about graph differences+    --  Some tests will fail with this setting, so revert to True to+    --  get test result.+    if True then+        testCompareEq "testGraphEq:" lab eq gg1 gg2+    else+        TestList+            [ TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )+            , TestCase ( assertEqual ("testGraphEq:"++lab) gg1 gg2 )+            ]++testGraphEqM :: String -> Bool -> Maybe RDFGraph -> Maybe RDFGraph -> Test+testGraphEqM = testCompareEq "testGraphEq:"++t01, t02, t03, t04, t05, t06 :: Arc RDFLabel+t01 = arc s1 p1 o1+t02 = arc s2 p1 o2+t03 = arc s3 p1 o3+t04 = arc s1 p1 l1+t05 = arc s2 p1 l4+t06 = arc s3 p1 l10++t10, t11, t12 :: Arc RDFLabel+t10 = arc s1 p1 b1+t11 = arc b1 p2 b2+t12 = arc b2 p3 o1++t20, t21, t22 :: Arc RDFLabel+t20 = arc s1 p1 b3+t21 = arc b3 p2 b4+t22 = arc b4 p3 o1++tt01, tt02, tt03, tt04, tt05, tt06 :: Arc RDFLabel+tt01 = arc st1 p1 o1+tt02 = arc st2 p1 o2+tt03 = arc st3 p1 o3+tt04 = arc st1 p1 l1+tt05 = arc st2 p1 l4+tt06 = arc st3 p1 l10++makeNewPrefixNamespace :: (String,Namespace) -> Namespace+makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)++nslist :: LookupMap Namespace+nslist = LookupMap $ map makeNewPrefixNamespace+    [ ("base1",base1)+    , ("base2",base2)+    , ("base3",base3)+    , ("base4",base4)+    ]++nslistalt :: LookupMap Namespace+nslistalt = LookupMap $ map makeNewPrefixNamespace+    [ ("altbase1",base1)+    , ("altbase2",base2)+    , ("altbase3",base3)+    ]++toGraph :: [Arc RDFLabel] -> RDFGraph+toGraph stmts = NSGraph+        { namespaces = nslist+        , formulae   = emptyFormulaMap+        , statements = stmts+        }++g1, gt1 :: RDFGraph+g1  = toGraph [t01]+gt1 = toGraph [tt01]++-- Check for nonsensitivety of graph equility to namespace differences:++g1alt :: RDFGraph+g1alt = NSGraph+        { namespaces = nslistalt+        , formulae   = emptyFormulaMap+        , statements = [t01]+        }++--  Construct version of g1 using just URIs++uris1, urip1, urio1 :: ScopedName+uris1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"+urip1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#p1"+urio1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#o1"++tu01 :: Arc RDFLabel+tu01  = arc (Res uris1) (Res urip1) (Res urio1)++g1uri, g2, gt2, g3, gt3, g4, g5, g6, g7, g8, g9, g10 :: RDFGraph+g1uri = toGraph [tu01]+g2    = toGraph [t01,t02,t03,t04,t05,t06]+gt2   = toGraph [tt01,tt02,tt03,tt04,tt05,tt06]+g3    = toGraph [t06,t05,t04,t03,t02,t01]+gt3   = toGraph [tt06,tt05,tt04,tt03,tt02,tt01]+g4    = toGraph [t01,t02,t03,t04,t05,t06,t10,t11,t12]+g5    = toGraph [t01,t02,t03,t04,t05,t06,t20,t21,t22]+g6    = toGraph [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]+g7    = toGraph [t01,t02]+g8    = toGraph [t02,t01]+g9    = toGraph [t03,t02,t01]+g10   = toGraph [t02,t02,t01]++g9a, g10a :: RDFGraph+g9a  = addArc t03 g8+g10a = addArc t02 g8++glist :: [(String, RDFGraph)]+glist =+  [ ("g1",g1), ("g1alt",g1alt), ("g1uri",g1uri)+  , ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6)+  , ("g7",g7), ("g8",g8), ("g9",g9), ("g10",g10)+  , ("g9a",g9a), ("g10a",g10a)+  ]++grapheqlist :: [(String, String)]+grapheqlist =+  [ ("g1","g1alt")+  , ("g1","g1uri")+  , ("g1alt","g1uri")+  , ("g2","g3")+  , ("g4","g5")+  , ("g7","g8")+  , ("g7","g10")+  , ("g7","g10a")+  , ("g8","g10")+  , ("g8","g10a")+  , ("g9","g9a")+  , ("g10","g10a")+  ]++testGraphEqSuite :: Test+testGraphEqSuite = TestList+  [ testGraphEq (tLab ll1 ll2) (tEq ll1 ll2) gg1 gg2+      | (ll1,gg1) <- glist , (ll2,gg2) <- glist ]+    where+    tLab ll1 ll2 = ll1 ++ "-" ++ ll2+    tEq  ll1 ll2 = (ll1 == ll2)        ||+            (ll1,ll2) `elem` grapheqlist ||+            (ll2,ll1) `elem` grapheqlist++-- Selected tests for debugging++testGraphEqSelSuite :: Test+testGraphEqSelSuite = TestList+  [ testGraphEq "g1-g2" False g1 g2+  , testGraphEq "g2-g1" False g2 g1+  , testGraphEq "g2-g2" True  g2 g2+  , testGraphEq "g2-g3" True  g2 g3+  , testGraphEq "g1-g4" False g1 g4+  , testGraphEq "g2-g4" False g2 g4+  , testGraphEq "g7-g7" True  g7 g7+  , testGraphEq "g7-g8" True  g7 g8+  , testGraphEq "g8-g7" True  g8 g7+  , testGraphEq "g9-g9a"   True g9 g9a+  , testGraphEq "g10-g10a" True g10 g10a+  ]++------------------------------------------------------------+--  Test updating formulae+------------------------------------------------------------++testFormulaLookup ::+    String -> FormulaMap RDFLabel -> RDFLabel -> Maybe RDFGraph -> Test+testFormulaLookup lab fs fl gr =+  testCompare "testFormulaLookup:" lab gr jfg+    where+      jfg = mapFindMaybe fl fs++testMaybeEq :: (Eq a, Show a) => String -> Maybe a -> Maybe a -> Test+testMaybeEq = testCompare "testMaybeEq:"++g1f1, g1f2, g1f3, g1f4, g1f5, g1f6, g1f7 :: RDFGraph+g1f1 = g1+g1f2 = setFormulae fm2 g1f1+g1f3 = setFormulae fm3 g1f1+g1f4 = setFormulae fm4 g1f1+g1f5 = setFormulae fm5 g1f1+g1f6 = setFormulae fm6 g1f1+g1f7 = setFormulae fm7 g1f1++fm2, fm3, fm4, fm5, fm6, fm7 :: LookupMap (LookupFormula RDFLabel RDFGraph)+fm2  = LookupMap [Formula s2 g2]+fm3  = LookupMap [Formula s1 g1,Formula s2 g2,Formula s3 g3]+fm4  = LookupMap [Formula s1 g1,Formula s2 g3,Formula s3 g3]+fm5  = LookupMap [Formula s1 g1,Formula s2 g4,Formula s3 g6]+fm6  = LookupMap [Formula s1 g1,Formula s2 g5,Formula s3 g6]+fm7  = LookupMap [Formula s1 g1,Formula s2 g7,Formula s3 g6]++f1, f2, f3, f4, f5, f6, f7 :: FormulaMap RDFLabel+f1   = getFormulae g1f1+f2   = getFormulae g1f2+f3   = getFormulae g1f3+f4   = getFormulae g1f4+f5   = getFormulae g1f5+f6   = getFormulae g1f6+f7   = getFormulae g1f7++--  Same pattern as 1-3, but using base graph with more nodes used:+--  The graph comparison results are expected to be different,+--  because of formulae associated with nodes actually used in the+--  graph++g2f1, g2f2, g2f3 :: RDFGraph+g2f1 = g2+g2f2 = setFormulae fm2 g2f1+g2f3 = setFormulae fm3 g2f1++f8, f9, f10 :: FormulaMap RDFLabel+f8   = getFormulae g2f1+f9   = getFormulae g2f2+f10  = getFormulae g2f3++--  Comparison of graphs containing formulae.+--  The intent is that graphs are matched if there is a bijection,+--  where the matched nodes are associated with matching formulae.+--  Definitions of formulae not used in the graphs don't affect the+--  match result.++--  Test methods to set/access an individual formula in a graph++g1f21, g1f22 :: RDFGraph+g1f21 = setFormula  (Formula s1 g7) g1f2+g1f22 = setFormula  (Formula s1 g1) g1f21++f21, f22 :: FormulaMap RDFLabel+f21  = getFormulae g1f21+f22  = getFormulae g1f22++f23a, f23b, f23c :: Maybe (NSGraph RDFLabel)+f23a = getFormula g1f22 s1+f23b = getFormula g1f22 s2+f23c = getFormula g1f22 s3++testGraphFormulaSuite :: Test+testGraphFormulaSuite = TestLabel "TestFormulae" $ TestList+  [ testFormulaLookup "01a" f1 s1 Nothing+  , testFormulaLookup "01b" f1 s2 Nothing+  , testFormulaLookup "01c" f1 s3 Nothing+  , testFormulaLookup "02a" f2 s1 Nothing+  , testFormulaLookup "02b" f2 s2 (Just g2)+  , testFormulaLookup "02c" f2 s3 Nothing+  , testFormulaLookup "03a" f3 s1 (Just g1)+  , testFormulaLookup "03b" f3 s2 (Just g2)+  , testFormulaLookup "03c" f3 s3 (Just g3)+  , testFormulaLookup "04a" f4 s1 (Just g1)+  , testFormulaLookup "04b" f4 s2 (Just g3)+  , testFormulaLookup "04c" f4 s3 (Just g3)+  , testFormulaLookup "05a" f5 s1 (Just g1)+  , testFormulaLookup "05b" f5 s2 (Just g4)+  , testFormulaLookup "05c" f5 s3 (Just g6)+  , testFormulaLookup "06a" f6 s1 (Just g1)+  , testFormulaLookup "06b" f6 s2 (Just g5)+  , testFormulaLookup "06c" f6 s3 (Just g6)+  , testFormulaLookup "07a" f7 s1 (Just g1)+  , testFormulaLookup "07b" f7 s2 (Just g7)+  , testFormulaLookup "07c" f7 s3 (Just g6)+  , testFormulaLookup "08a" f8 s1 Nothing+  , testFormulaLookup "08b" f8 s2 Nothing+  , testFormulaLookup "08c" f8 s3 Nothing+  , testFormulaLookup "09a" f9 s1 Nothing+  , testFormulaLookup "09b" f9 s2 (Just g2)+  , testFormulaLookup "09c" f9 s3 Nothing+  , testFormulaLookup "10a" f10 s1 (Just g1)+  , testFormulaLookup "10b" f10 s2 (Just g2)+  , testFormulaLookup "10c" f10 s3 (Just g3)+  , testGraphEq "g1f1-g1f1" True  g1f1 g1f1+  , testGraphEq "g1f1-g1f2" True  g1f1 g1f2+  , testGraphEq "g1f1-g1f3" False g1f1 g1f3+  , testGraphEq "g1f2-g1f1" True  g1f2 g1f1+  , testGraphEq "g1f2-g1f2" True  g1f2 g1f2+  , testGraphEq "g1f2-g1f3" False g1f2 g1f3+  , testGraphEq "g1f3-g1f1" False g1f3 g1f1+  , testGraphEq "g1f3-g1f2" False g1f3 g1f2+  , testGraphEq "g1f3-g1f3" True  g1f3 g1f3+  , testGraphEq "g1f4-g1f3" True  g1f4 g1f3+  , testGraphEq "g1f4-g1f4" True  g1f4 g1f4+  , testGraphEq "g1f4-g1f5" True  g1f4 g1f5+  , testGraphEq "g1f5-g1f5" True  g1f5 g1f5+  , testGraphEq "g1f5-g1f6" True  g1f5 g1f6+  , testGraphEq "g1f5-g1f7" True  g1f5 g1f7+  , testGraphEq "g1f6-g1f5" True  g1f6 g1f5+  , testGraphEq "g1f6-g1f6" True  g1f6 g1f6+  , testGraphEq "g1f6-g1f7" True  g1f6 g1f7+  , testGraphEq "g1f7-g1f5" True  g1f7 g1f5+  , testGraphEq "g1f7-g1f6" True  g1f7 g1f6+  , testGraphEq "g1f7-g1f7" True  g1f7 g1f7+  , testGraphEq "g2f1-g2f1" True  g2f1 g2f1+  , testGraphEq "g2f1-g2f2" False g2f1 g2f2+  , testGraphEq "g2f1-g2f3" False g2f1 g2f3+  , testGraphEq "g2f2-g2f1" False g2f2 g2f1+  , testGraphEq "g2f2-g2f2" True  g2f2 g2f2+  , testGraphEq "g2f2-g2f3" False g2f2 g2f3+  , testGraphEq "g2f3-g2f1" False g2f3 g2f1+  , testGraphEq "g2f3-g2f2" False g2f3 g2f2+  , testGraphEq "g2f3-g2f3" True  g2f3 g2f3+  , testFormulaLookup "21a" f21 s1 (Just g7)+  , testFormulaLookup "21b" f21 s2 (Just g2)+  , testFormulaLookup "21c" f21 s3 Nothing+  , testFormulaLookup "22a" f22 s1 (Just g1)+  , testFormulaLookup "22b" f22 s2 (Just g2)+  , testFormulaLookup "22c" f22 s3 Nothing+  , testMaybeEq "23a" f23a (Just g1)+  , testMaybeEq "23b" f23b (Just g2)+  , testMaybeEq "23c" f23c Nothing+  ]++------------------------------------------------------------+--  Test fmap translations of graphs, including formulae+------------------------------------------------------------++translate :: RDFLabel -> RDFLabel+translate lab+    | lab == s1 = st1+    | lab == s2 = st2+    | lab == s3 = st3+    | otherwise = lab++translateM :: RDFLabel -> Maybe RDFLabel+translateM lab+    | lab == s1   = Just st1+    | lab == s2   = Just st2+    | lab == s3   = Just st3+    | isBlank lab = Nothing+    | otherwise   = Just lab++gt1f1a, gt1f1b, gt1f2a, gt1f2b, gt1f3a, gt1f3b,+  gt2f1a, gt2f1b, gt2f2a, gt2f2b,+  gt2f3a, gt2f3b :: RDFGraph+gt1f1a = gt1+gt1f1b = fmap translate g1f1+gt1f2a = setFormulae ftm2 gt1+gt1f2b = fmap translate g1f2+gt1f3a = setFormulae ftm3 gt1+gt1f3b = fmap translate g1f3+gt2f1a = gt2+gt2f1b = fmap translate g2f1+gt2f2a = setFormulae ftm2 gt2+gt2f2b = fmap translate g2f2+gt2f3a = setFormulae ftm3 gt2+gt2f3b = fmap translate g2f3++ft1, ft2, ft3, ft4, ft5, ft6 :: FormulaMap RDFLabel+ft1 = getFormulae gt1f1b+ft2 = getFormulae gt1f2b+ft3 = getFormulae gt1f3b+ft4 = getFormulae gt2f1b+ft5 = getFormulae gt2f2b+ft6 = getFormulae gt2f3b++ftm2, ftm3 :: FormulaMap RDFLabel+ftm2   = LookupMap [Formula st2 gt2]+ftm3   = LookupMap [Formula st1 gt1,Formula st2 gt2,Formula st3 gt3]++-- Monadic translate tests, using Maybe Monad++gt1f1aM, gt1f1bM, gt1f2aM, gt1f2bM, gt1f5M :: Maybe RDFGraph+gt1f1aM = Just gt1+gt1f1bM = T.mapM translateM g1f1+gt1f2aM = Just gt1f2a+gt1f2bM = T.mapM translateM g1f2+gt1f5M = T.mapM translateM g1f5++ft1M, ft2M :: FormulaMap RDFLabel+ft1M = getFormulae $ fromJust gt1f1bM+ft2M = getFormulae $ fromJust gt1f2bM++testGraphTranslateSuite :: Test+testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList+  [ testGraphEq "gt1f1a-gt1f1b" True gt1f1a gt1f1b+  , testFormulaLookup "GraphTranslate01b" ft1 st1 Nothing+  , testFormulaLookup "GraphTranslate01c" ft1 st2 Nothing+  , testFormulaLookup "GraphTranslate01d" ft1 st3 Nothing+  , testEq "gt1f1a-gt1f1b" gt1f1a gt1f1b+  , testGraphEq "gt1f2a-gt1f2b" True gt1f2a gt1f2b+  , testFormulaLookup "GraphTranslate02b" ft2 st1 Nothing+  , testFormulaLookup "GraphTranslate02c" ft2 st2 (Just gt2)+  , testFormulaLookup "GraphTranslate02d" ft2 st3 Nothing+  , testGraphEq "gt1f3a-gt1f3b" True gt1f3a gt1f3b+  , testFormulaLookup "GraphTranslate03b" ft3 st1 (Just gt1)+  , testFormulaLookup "GraphTranslate03c" ft3 st2 (Just gt2)+  , testFormulaLookup "GraphTranslate03d" ft3 st3 (Just gt3)+  , testGraphEq "gt2f1a-gt2f1b" True gt2f1a gt2f1b+  , testFormulaLookup "GraphTranslate04b" ft4 st1 Nothing+  , testFormulaLookup "GraphTranslate04c" ft4 st2 Nothing+  , testFormulaLookup "GraphTranslate04d" ft4 st3 Nothing+  , testGraphEq "gt2f2a-gt2f2b" True gt2f2a gt2f2b+  , testFormulaLookup "GraphTranslate05b" ft5 st1 Nothing+  , testFormulaLookup "GraphTranslate05c" ft5 st2 (Just gt2)+  , testFormulaLookup "GraphTranslate05d" ft5 st3 Nothing+  , testGraphEq "gt2f3a-gt2f3b" True gt2f3a gt2f3b+  , testFormulaLookup "GraphTranslate06b" ft6 st1 (Just gt1)+  , testFormulaLookup "GraphTranslate06c" ft6 st2 (Just gt2)+  , testFormulaLookup "GraphTranslate06d" ft6 st3 (Just gt3)+  , testGraphEqM "gt1f1aM-gt1f1bM" True gt1f1aM gt1f1bM+  , testFormulaLookup "GraphTranslate07b" ft1M st1 Nothing+  , testFormulaLookup "GraphTranslate07c" ft1M st2 Nothing+  , testFormulaLookup "GraphTranslate07d" ft1M st3 Nothing+  , testEq "gt1f1aM-gt1f1bM" gt1f1aM gt1f1bM+  , testGraphEqM "gt1f2aM-gt1f2bM" True gt1f2aM gt1f2bM+  , testFormulaLookup "GraphTranslate08b" ft2M st1 Nothing+  , testFormulaLookup "GraphTranslate08c" ft2M st2 (Just gt2)+  , testFormulaLookup "GraphTranslate08d" ft2M st3 Nothing+  , testEq "gt1f2aM-gt1f2bM" gt1f2aM gt1f1bM+  , testEq "GraphTranslate09a" Nothing gt1f5M+  ]++------------------------------------------------------------+--  Test merge with conflicting bnodes, including formulae+------------------------------------------------------------++testMerge :: String -> RDFGraph -> RDFGraph -> RDFGraph -> Test+testMerge lab a1 a2 gr =+    TestCase ( assertEquiv ("testMerge:"++lab) gr (merge a1 a2) )+        where+            grequiv gg1 gg2 = (getArcs gg1) `equiv` (getArcs gg2)+            assertEquiv lbl gg1 gg2 = assertString $+                if grequiv gg1 gg2 then ""+                else lbl++"\nExpected: "++(show gg1)++"\nObtained: "++(show gg2)++testEquiv :: (Eq a) => String -> [a] -> [a] -> Test+testEquiv lab l1s l2s = TestCase $ assertBool lab (l1s `equiv` l2s)++tm01, tm02, tm03, tm04, tm05, tm06, tm07, tm08, tm09,+  tm10, tm11, tm12, tm13, tm14 :: Arc RDFLabel+tm01 = arc s1  p1 b1+tm02 = arc b1  p1 o2+tm03 = arc b1  p1 o3+tm04 = arc b2  p2 b3+tm05 = arc b3  p2 b4+tm06 = arc bb  p2 b5+tm07 = arc s2  p3 v1+tm08 = arc s3  p3 v2+tm09 = arc s4  p1 c1+tm10 = arc c2  p1 o4+tm11 = arc s4  p2 ba1+tm12 = arc ba2 p2 o4+tm13 = arc s4  p2 bn3+tm14 = arc bn4 p2 o4++tm21, tm22, tm23, tm24, tm25, tm26, tm27, tm28, tm29,+  tm30, tm31, tm32, tm33, tm34 :: Arc RDFLabel+tm21 = arc s1  p1 b6+tm22 = arc b6  p1 o2+tm23 = arc b6  p1 o3+tm24 = arc b7  p2 b8+tm25 = arc b8  p2 b9+tm26 = arc bb0 p2 b10+tm27 = arc s2  p3 v3+tm28 = arc s3  p3 v4+tm29 = arc s4  p1 c3+tm30 = arc c4  p1 o4+tm31 = arc s4  p2 ba3+tm32 = arc ba4 p2 o4+tm33 = arc s4  p2 bn5+tm34 = arc bn6 p2 o4++tm41, tm42, tm43, tm44 :: Arc RDFLabel+tm41  = arc s1  p1 b2+tm42  = arc b2  p1 o2+tm43  = arc b2  p1 o3+tm44  = arc b4  p2 b5++tm41a, tm44a :: Arc RDFLabel+tm41a = arc s1  p1 b4+tm44a = arc b5  p2 b6++tm67, tm68, tm69, tm70, tm71, tm72,+  tm73, tm74 :: Arc RDFLabel+tm67 = arc s2  p3 v3+tm68 = arc s3  p3 v4+tm69 = arc s4  p1 c3+tm70 = arc c4  p1 o4+tm71 = arc s4  p2 ba3+tm72 = arc ba4 p2 o4+tm73 = arc s4  p2 bn5+tm74 = arc bn6 p2 o4++gm1, gm11, gm2, gm2f, gm22, gm3, gm3f, gm33,+  gm4, gm44 :: RDFGraph+gm1  = toGraph [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08+               ,tm09,tm10,tm11,tm12,tm13,tm14+               ]+gm11 = toGraph [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08+               ,tm09,tm10,tm11,tm12,tm13,tm14+               ,tm21,tm22,tm23,tm24,tm25,tm26,tm27,tm28+               ,tm29,tm30,tm31,tm32,tm33,tm34+               ]+gm2  = toGraph [tm01]+gm2f = toGraph [tm41]+gm22 = toGraph [tm01,tm41]+gm3  = toGraph [tm04]+gm3f = toGraph [tm44]+gm33 = toGraph [tm04,tm44]+gm4  = toGraph [tm01,tm04]+gm44 = toGraph [tm01,tm04,tm41a,tm44a]++gm5, gm55, gm6, gm66 :: RDFGraph+gm5  = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 gm2]+        , statements = [tm01,tm02,tm03]+        }++gm55 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 gm2,Formula b2 gm2f]+        , statements = [tm01,tm02,tm03,tm41,tm42,tm43]+        }++gm6 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula ba1 gm2,Formula bn3 gm3]+        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14]+        }++gm66 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap+                       [Formula ba1 gm2,Formula bn3 gm3+                       ,Formula ba3 gm2f,Formula bn5 gm3f+                       ]+        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14+                       ,tm67,tm68,tm69,tm70,tm71,tm72,tm73,tm74+                       ]+        }++tm81, tm82, tm811, tm821, tm812, tm822 :: Arc RDFLabel+tm81  = arc b1 p1 v1+tm82  = arc b2 p2 v2+tm811 = arc b1 p1 v3+tm821 = arc b2 p2 v4+tm812 = arc b1 p1 vb3+tm822 = arc b2 p2 vb4++gm82b1, gm82b2 :: [(RDFLabel,RDFLabel)]+gm82b1 = remapLabelList [v1,v2] [v1,v2,b1,b2]+gm82b2 = [(v1,v3),(v2,v4)]++gm81, gm82, gm82a, gm83, gm83a :: RDFGraph+gm81   = toGraph [tm81,tm82]+gm82   = toGraph [tm811,tm821]+gm82a  = remapLabels [v1,v2] [v1,v2,b1,b2] id gm81+gm83   = toGraph [tm811,tm821]+gm83a  = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm81++gm84, gm85, gm85a, gm86, gm86a :: RDFGraph+gm84  = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 gm81,Formula v2 gm81]+        , statements = [tm81,tm82]+        }++gm85 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 gm82,Formula v4 gm82]+        , statements = [tm811,tm821]+        }+gm85a = remapLabels [v1,v2] [v1,v2,b1,b2] id gm84++gm86 = NSGraph+        { namespaces = nslist+        , formulae   = LookupMap [Formula b1 gm82,Formula vb4 gm82]+        , statements = [tm812,tm822]+        }+gm86a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm84++testMergeSuite :: Test+testMergeSuite = TestList+  [ testMerge "01" gm1 gm1 gm11+  , testMerge "02" gm2 gm2 gm22+  , testMerge "03" gm3 gm3 gm33+  , testMerge "04" gm4 gm4 gm44+  , testMerge "05" gm5 gm5 gm55+  , testMerge "06" gm6 gm6 gm66+  , testGraphEq "Remap07" True gm82 gm82a+  , testEquiv "testRemapList07" gm82b2 gm82b1+  , testGraphEq "Remap08" True gm83 gm83a+  , testGraphEq "Remap09" True gm85 gm85a+  , testGraphEq "Remap10" True gm86 gm86a+  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testLangEqSuite+  , testNodeEqSuite+  , testNodeClassSuite+  , testNodeLocalSuite+  , testNewNodeSuite+  , testNodeOrdSuite+  , testLabelOtherSuite+  , testStmtEqSuite+  , testGraphEqSuite+  , testGraphEqSelSuite+  , testGraphFormulaSuite+  , testGraphTranslateSuite+  , testMergeSuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT++geq  = testGraphEqSuite+nord = testNodeOrdSuite+gtr  = testGraphTranslateSuite++gmm g1 g2 = grMatchMap g1 g2+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFProofContextTest.hs view
@@ -0,0 +1,720 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFProofContextTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains RDF proof-checking test cases based on the RDF+--  semantics specifications, as capured in module RDFProofContext.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.BuiltInMap+    ( rdfRulesetMap, allRulesets )++import Swish.RDF.RDFProofContext+    ( rulesetRDF+    , rulesetRDFS+    , rulesetRDFD )++import Swish.RDF.RDFProof+    ( RDFProof, RDFProofStep+    , makeRDFProof, makeRDFProofStep )++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFRuleset+    , nullRDFFormula+    , makeRDFFormula )++import Swish.RDF.RDFGraph+    ( RDFGraph )++import Swish.RDF.RDFGraphShowM()++import Swish.RDF.Proof+    ( Step(..)+    , checkProof, checkStep+    , explainProof)++import Swish.RDF.Ruleset+    ( getContextAxiom, getContextRule )++import Swish.RDF.Rule+    ( Formula(..), Rule(..)+    , nullFormula, nullRule )++import Swish.Utils.Namespace+    ( Namespace(..), ScopedName(..) )++import Swish.Utils.LookupMap+    ( mapFindMaybe )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceRDFS+    , namespaceRDFD+    , namespaceXSD+    , namespaceXsdType+    , scopeRDF+    , scopeRDFS+    , scopeRDFD+    )++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertBool, assertEqual+    , runTestTT )++import Data.Maybe+    ( isJust, isNothing, fromJust, fromMaybe )++--  misc helpers++test :: String -> Bool -> Test+test lab tst = TestCase $ assertBool lab tst++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab e a = TestCase $ assertEqual lab e a++testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test+testJe lab e a = TestList+    [ TestCase $ assertBool  lab (isJust a)+    , TestCase $ assertEqual lab e (fromJust a)+    ]++testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test+testJl lab e a = TestList+    [ TestCase $ assertBool  lab   (isJust a)+    , TestCase $ assertEqual lab e (length (fromJust a))+    ]++testNo :: (Eq a, Show a) => String -> [[a]] -> Test+testNo lab a =+    TestCase $ assertBool  lab   (null a)++testGr :: String -> RDFGraph -> [RDFGraph] -> Test+testGr lab eg a = TestCase $ assertBool lab (eg `elem` a)++-- testProof "rdfProof01" True rdfProof01+testProof :: String -> Bool -> RDFProof -> Test+testProof lab valid proof = TestList+    [ TestCase $ assertEqual lab valid (checkProof proof)+    , TestCase $ assertBool  (lab++": "++ex) (valid == (isNothing $ expl))+    ]+    where+        expl = explainProof proof+        ex   = fromMaybe "(Proof OK)" expl++-- testProofStep "rdfStep01" True [rules] [antes] rdfStep01+testProofStep ::+    String -> Bool -> [RDFRule] -> [RDFGraph] -> Step RDFGraph+    -> Test+testProofStep lab valid rules antes step =+    TestCase $ assertEqual lab valid (checkStep rules antes step)++--  Various support methods++makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula scope local gr =+    makeRDFFormula scope local (prefix++gr)++getRule :: String -> RDFRule+getRule nam = getContextRule (makeSName nam) nullRule $+    rdfdContext++[rulesetXsdInt,rulesetXsdStr]++getAxiom :: String -> RDFFormula+getAxiom nam = getContextAxiom (makeSName nam) nullRDFFormula rdfdContext++makeSName :: String -> ScopedName+makeSName nam = ScopedName ns loc+    where+        (pre,_:loc) = break (==':') nam+        ns = case pre of+            "rs_rdf"  -> scopeRDF+            "rs_rdfs" -> scopeRDFS+            "rs_rdfd" -> scopeRDFD+            "xsd_integer" -> (namespaceXsdType "integer")+            "xsd_string"  -> (namespaceXsdType "string")+            _ -> error ("makeSName: Unrecognized prefix in rule name: "++nam)++--  Common definitions++prefix :: String+prefix =+    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" +++    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" +++    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" +++    "@prefix xsd:  <" ++ nsURI namespaceXSD  ++ "> . \n" +++    "@prefix ex:   <http://example.org/> . \n" +++    " \n"++scopeex :: Namespace+scopeex   = Namespace "ex"   "http://id.ninebynine.org/wip/2003/RDFProofCheck#"++rdfContext, rdfsContext, rdfdContext, xsdintContext,+  xsdstrContext :: [RDFRuleset]+rdfContext    = [ rulesetRDF ]+rdfsContext   = [ rulesetRDF, rulesetRDFS ]+rdfdContext   = [ rulesetRDF, rulesetRDFS, rulesetRDFD ]+xsdintContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdInt ]+xsdstrContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdStr ]++rulesetXsdInt, rulesetXsdStr :: RDFRuleset+rulesetXsdInt = fromJust $ mapFindMaybe (namespaceXsdType "integer") rdfRulesetMap+rulesetXsdStr = fromJust $ mapFindMaybe (namespaceXsdType "string") rdfRulesetMap++------------------------+--  RDF/S rule tests+------------------------+--+--  These tests aim to exercise the specific closure rule constructs+--  that are used by the RDF/S rules.  They have been prepared as a+--  regression test for a refactoring of the variable binding+--  filtering and modification logic.++--  Simple rule test - forward and backward chaining+--+--  rdfr1 = "?x ?a ?y ." => "?a rdf:type rdf:Property ."+--++rdfr1 :: RDFRule+rdfr1  = getRule "rs_rdf:r1"++ant01, con01, bwd01 :: RDFGraph+ant01  = formExpr $ makeFormula scopeex "ant01" $+    "ex:s ex:p1 ex:o1 ; ex:p2 ex:o2 ."+con01  = formExpr $ makeFormula scopeex "con01" $+    "ex:p1 rdf:type rdf:Property ." +++    "ex:p2 rdf:type rdf:Property ."+bwd01  = formExpr $ makeFormula scopeex "bwd01a" $+    "_:s1 ex:p1 _:o1 . " +++    "_:s2 ex:p2 _:o2 . "++--  Simple rule test - no match forward or backward+--+--  rdfsr2 = "?x ?a ?y . ?a rdfs:domain ?z ." => "?x rdf:type ?z ."+--++rdfsr2 :: RDFRule+rdfsr2 = getRule "rs_rdfs:r2"++ant02, con02 :: RDFGraph+ant02  = formExpr $ makeFormula scopeex "ant02" $+    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."+con02  = formExpr $ makeFormula scopeex "con02" $+    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."++--  Rule with literal test and "allocateTo":+--  match forward, but not backward+--+--  This is a two-part rule: (a) apply rdflg, (b) apply rdfr2+--+--  rdflg = "?x ?a ?l . " => "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."+--  where:+--          (isLiteral "?l")+--          (allocateTo "?b" "?l")+--+--  rdfr2 = "?x ?a ?l . ?b rdf:_allocatedTo ?l . "+--          => "?b rdf:type rdf:XMLLiteral ."+--  where:+--          (isXMLLit "?l")+--++rdflg, rdfr2 :: RDFRule+rdflg  = getRule "rs_rdf:lg"+rdfr2  = getRule "rs_rdf:r2"++ant03, con03lg, con03r2 :: RDFGraph+ant03  = formExpr $ makeFormula scopeex "ant03" $+    "ex:s ex:p1  \"lit1\"^^rdf:XMLLiteral ; " +++    "     ex:p2a \"lit2\"^^rdf:XMLLiteral ; " +++    "     ex:p2b \"lit2\"^^rdf:XMLLiteral ."+con03lg  = formExpr $ makeFormula scopeex "con03" $+    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." +++    "_:l1 rdf:_allocatedTo \"lit1\"^^rdf:XMLLiteral ." +++    "_:l2 rdf:_allocatedTo \"lit2\"^^rdf:XMLLiteral ."+con03r2  = formExpr $ makeFormula scopeex "con03" $+    "_:l1 rdf:type rdf:XMLLiteral ." +++    "_:l2 rdf:type rdf:XMLLiteral ."++--  Rule with member property test, match forwards and backwards+--  rdfcp1 = "?x  ?c ?y . " => "?c rdf:type rdf:Property ."+--  where:+--          (isMemberProp "?c")+--++rdfcp :: RDFRule+rdfcp  = getRule "rs_rdf:cp1"++ant04, con04, bwd04 :: RDFGraph+ant04  = formExpr $ makeFormula scopeex "ant04" $+    "ex:s rdf:_123 ex:o1 ; " +++    "     rdf:_2   ex:o2 . "+con04  = formExpr $ makeFormula scopeex "con04" $+    "rdf:_123 rdf:type rdf:Property ." +++    "rdf:_2   rdf:type rdf:Property ."+bwd04  = formExpr $ makeFormula scopeex "bwd04a" $+    "_:s1 rdf:_123 _:o1 . " +++    "_:s2 rdf:_2   _:o2 . "++--  Rule with disjunction test, match forwards and backwards+--+--  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."+--  where:+--          (requireAny [isUriRef "?u",isBlank "?u"])+--++rdfsr3 :: RDFRule+rdfsr3 = getRule "rs_rdfs:r3"++ant05, con05, bwd05 :: RDFGraph+ant05  = formExpr $ makeFormula scopeex "ant05" $+    "ex:s ex:p1 ex:o1 ; "        +++    "     ex:p2 _:o2  . "        +++    "ex:p1 rdfs:range ex:pr1 . " +++    "ex:p2 rdfs:range ex:pr2 . "+con05  = formExpr $ makeFormula scopeex "con05" $+    "ex:o1 rdf:type ex:pr1 ." +++    "_:o2  rdf:type ex:pr2 ."+bwd05  = formExpr $ makeFormula scopeex "bwd05a" $+    "_:s1 _:p1 ex:o1 . "        +++    "_:s2 _:p2 _:o2  . "        +++    "_:p1 rdfs:range ex:pr1 . " +++    "_:p2 rdfs:range ex:pr2 . "++--  Rule with disjunction test, fail forwards+--+--  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."+--  where:+--          (requireAny [isUriRef "?u",isBlank "?u"])+--++ant06, con06, bwd06, chk06 :: RDFGraph+ant06  = formExpr $ makeFormula scopeex "ant06" $+    "ex:s ex:p1 \"lit1\" . "     +++    "ex:p1 rdfs:range ex:pr1 . "+con06  = formExpr $ makeFormula scopeex "con06" $+    "_:o1  rdf:type ex:pr1 ."+bwd06  = formExpr $ makeFormula scopeex "bwd06a" $+    "_:s1 _:p1 _:o1 . "      +++    "_:p1 rdfs:range ex:pr1 . "+chk06  = formExpr $ makeFormula scopeex "bwd06a" $+    "_:s1 _:p1 \"lit1\" . "      +++    "_:p1 rdfs:range ex:pr1 . "++--  Collected rule tests++testRules :: Test+testRules = +  TestList+  [ testEq "testRule01a" "rs_rdf:r1" (show $ ruleName rdfr1)+  , testEq "testRule01b" [con01]     (fwdApply rdfr1 [ant01])+  , testEq "testRule01c" [[bwd01]]   (bwdApply rdfr1 con01)+  , test   "testRule01d" (checkInference rdfr1 [ant01] con01)+  , test   "testRule01e" (checkInference rdfr1 [bwd01] con01)+  , testEq "testRule02a" "rs_rdfs:r2" (show $ ruleName rdfsr2)+  , testEq "testRule02b" []           (fwdApply rdfsr2 [ant02])+  , testEq "testRule02c" []           (bwdApply rdfsr2 con02)+  , testEq "testRule02d" False (checkInference rdfsr2 [ant02] con02)+  , testEq "testRule03a" "rs_rdf:lg" (show $ ruleName rdflg)+  , testEq "testRule03b" "rs_rdf:r2" (show $ ruleName rdfr2)+  , testEq "testRule03c" [con03lg]   (fwdApply rdflg [ant03])+  , testEq "testRule03d" []          (bwdApply rdflg con03lg)+  , test   "testRule03e" (checkInference rdflg [ant03] con03lg)+  , testEq "testRule03f" [con03r2]   (fwdApply rdfr2 [con03lg])+  , testEq "testRule03g" []          (bwdApply rdfr2 con03r2)+  , test   "testRule03h" (checkInference rdfr2 [con03lg] con03r2)+  , testEq "testRule04a" "rs_rdf:cp1" (show $ ruleName rdfcp)+  , testEq "testRule04b" [con04]      (fwdApply rdfcp [ant04])+  , testEq "testRule04c" [[bwd04]]    (bwdApply rdfcp con04)+  , test   "testRule04d" (checkInference rdfcp [ant04] con04)+  , test   "testRule01e" (checkInference rdfcp [bwd04] con04)+  , testEq "testRule05a" "rs_rdfs:r3" (show $ ruleName rdfsr3)+  , testEq "testRule05b" [con05]      (fwdApply rdfsr3 [ant05])+  , testEq "testRule05c" [[bwd05]]    (bwdApply rdfsr3 con05)+  , test   "testRule05d" (checkInference rdfsr3 [ant05] con05)+  , test   "testRule01e" (checkInference rdfsr3 [bwd05] con05)+  , testEq "testRule06a" "rs_rdfs:r3" (show $ ruleName rdfsr3)+  , testEq "testRule06b" []           (fwdApply rdfsr3 [ant06])+  , testEq "testRule06c" [[bwd06]]    (bwdApply rdfsr3 con06)+  , testEq "testRule06d" False (checkInference rdfsr3 [ant06] con06)+  , testEq "testRule06e" True  (checkInference rdfsr3 [bwd06] con06)+  , testEq "testRule06e" False (checkInference rdfsr3 [chk06] con06)+  ]++------------------------+--  Complete proof tests+------------------------+--+--  These are a few tests of complete RDF proof chains based on the+--  RDF semantic rules.++--  RDF entailment proof checks++rdfBase01, rdfGoal01 :: RDFFormula+rdfBase01  = makeFormula scopeex "rdfBase01" "ex:s ex:p ex:o ."+rdfGoal01  = makeFormula scopeex "rdfGoal01" "ex:p rdf:type rdf:Property ."++rdfStep01a :: RDFProofStep+rdfStep01a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase01] rdfGoal01++rdfProof01 :: RDFProof+rdfProof01 = makeRDFProof rdfsContext rdfBase01 rdfGoal01+                [ rdfStep01a ]++rdfBase02, rdfCon02a, rdfGoal02 :: RDFFormula+rdfBase02  = makeFormula scopeex "rdfBase02" $+                "ex:s ex:p \"l1\"^^rdf:XMLLiteral ."+rdfCon02a  = makeFormula scopeex "rdfStep02a" $+                "ex:s ex:p _:lll . "             +++                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "+rdfGoal02  = makeFormula scopeex "rdfGoal02" $+                "_:lll rdf:type rdf:XMLLiteral . "+                +rdfStep02a, rdfStep02b :: RDFProofStep                +rdfStep02a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase02] rdfCon02a+rdfStep02b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon02a] rdfGoal02++rdfProof02 :: RDFProof+rdfProof02 = makeRDFProof rdfsContext rdfBase02 rdfGoal02+                [ rdfStep02a, rdfStep02b ]++rdfBase03, rdfCon03a, rdfGoal03 :: RDFFormula+rdfBase03  = makeFormula scopeex "rdfBase03" $+                "ex:s ex:p ex:o ."+rdfCon03a  = makeFormula scopeex "rdfStep03a" $+                "ex:s ex:p _:lll . "             +++                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "+rdfGoal03  = makeFormula scopeex "rdfGoal03" $+                "_:lll rdf:type rdf:XMLLiteral . "++rdfStep03a, rdfStep03b :: RDFProofStep                +rdfStep03a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase03] rdfCon03a+rdfStep03b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon03a] rdfGoal03++rdfProof03 :: RDFProof+rdfProof03 = makeRDFProof rdfsContext rdfBase03 rdfGoal03+                [ rdfStep03a, rdfStep03b ]++rdfBase04, rdfGoal04 :: RDFFormula+rdfBase04  = makeFormula scopeex "rdfBase04" "ex:s ex:p ex:o ."+rdfGoal04  = makeFormula scopeex "rdfGoal04" "_:s  ex:p _:o ."++rdfStep04a :: RDFProofStep                +rdfStep04a = makeRDFProofStep (getRule "rs_rdf:se") [rdfBase04] rdfGoal04++rdfProof04 :: RDFProof+rdfProof04 = makeRDFProof rdfsContext rdfBase04 rdfGoal04+                [ rdfStep04a ]++rdfBase05 :: RDFFormula+rdfBase05  = makeFormula scopeex "rdfBase05" $+                "ex:s ex:p rdf:nil ."++rdfStep05a :: RDFProofStep+rdfStep05a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase05]  rdfCons05a++rdfCons05a :: RDFFormula+rdfCons05a = makeFormula scopeex "rdfCons05a" $+                "ex:p  rdf:type rdf:Property ."+                +rdfStep05b :: RDFProofStep+rdfStep05b = makeRDFProofStep (getRule "rs_rdf:se")+                [rdfBase05,rdfCons05a,(getAxiom "rs_rdf:a8")] rdfGoal05++rdfGoal05 :: RDFFormula+rdfGoal05  = makeFormula scopeex "rdfGoal05" $+                "ex:s _:p _:n ."               +++                "_:p  rdf:type rdf:Property ." +++                "_:n  rdf:type rdf:List ."+                +rdfProof05 :: RDFProof+rdfProof05 = makeRDFProof rdfsContext rdfBase05 rdfGoal05+                [ rdfStep05a, rdfStep05b ]++--  Swap rdfProof05 proof steps:++rdfProof06 :: RDFProof+rdfProof06 = makeRDFProof rdfsContext rdfBase05 rdfGoal05+                [ rdfStep05b, rdfStep05a ]++--  Proof using rdfsr1 and rdfsub+--+--    ex:s1 ex:p1 "lll"+--    ex:s2 ex:p2 "lll"+--  =>+--    ex:s1 ex:p1 _:l+--    ex:s2 ex:p2 _:l+--    _:l   rdf:type rdfs:Literal++rdfBase07 :: RDFFormula+rdfBase07  = makeFormula scopeex "rdfBase07" $+                "ex:s1 ex:p1 \"lll\" ." +++                "ex:s2 ex:p2 \"lll\" ." +++                "ex:s3 ex:p3 \"mmm\" ."+                +rdfStep07a :: RDFProofStep                +rdfStep07a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase07]  rdfCons07a++rdfCons07a :: RDFFormula+rdfCons07a = makeFormula scopeex "rdfCons07a" $+                "ex:s1 ex:p1 _:l ."              +++                "ex:s2 ex:p2 _:l ."              +++                "_:l rdf:_allocatedTo \"lll\" ." +++                "ex:s3 ex:p3 _:m ."              +++                "_:m rdf:_allocatedTo \"mmm\" ."+                +rdfStep07b :: RDFProofStep                +rdfStep07b = makeRDFProofStep (getRule "rs_rdfs:r1") [rdfCons07a]  rdfCons07b++rdfCons07b :: RDFFormula+rdfCons07b = makeFormula scopeex "rdfCons07a" $+                "_:l rdf:type rdfs:Literal ." +++                "_:m rdf:type rdfs:Literal ."++rdfStep07c :: RDFProofStep+rdfStep07c = makeRDFProofStep (getRule "rs_rdf:sub")+                [rdfCons07a,rdfCons07b] rdfGoal07++rdfGoal07 :: RDFFormula+rdfGoal07  = makeFormula scopeex "rdfGoal07" $+                "ex:s1 ex:p1 _:l ."           +++                "ex:s2 ex:p2 _:l ."           +++                "_:l rdf:type rdfs:Literal ."++rdfProof07 :: RDFProof+rdfProof07 = makeRDFProof rdfsContext rdfBase07 rdfGoal07+                [ rdfStep07a, rdfStep07b, rdfStep07c ]++--  Proof of:+--    rdf:_123 rdfs:supPropertyOf rdfs:member++rdfBase08 :: RDFFormula+rdfBase08  = makeFormula scopeex "rdfBase08" $+                "ex:s1 rdf:_123 ex:o ."+                +rdfStep08a :: RDFProofStep                +rdfStep08a = makeRDFProofStep (getRule "rs_rdfs:cp1") [rdfBase08]  rdfCons08a++rdfCons08a :: RDFFormula+rdfCons08a = makeFormula scopeex "rdfCons08a" $+                "rdf:_123 rdf:type rdfs:ContainerMembershipProperty ."+                +rdfStep08b :: RDFProofStep                +rdfStep08b = makeRDFProofStep (getRule "rs_rdfs:r12")  [rdfCons08a]  rdfGoal08++rdfGoal08 :: RDFFormula+rdfGoal08  = makeFormula scopeex "rdfCons08b" $+                "rdf:_123 rdfs:subPropertyOf rdfs:member ."+                +rdfProof08 :: RDFProof                +rdfProof08 = makeRDFProof rdfsContext rdfBase08 rdfGoal08+                [ rdfStep08a, rdfStep08b ]+++--  Proof of:+--    ex:s ex:p "010"^^xsd:Integer .+--  =>+--    ex:s ex:p "10"^^xsd:Integer .+--    ex:s ex:p _:b+--    _:b rdf:type xsd:integer .++rdfAxiomIntDt :: RDFFormula+rdfAxiomIntDt = getContextAxiom+                    (ScopedName (namespaceXsdType "integer") "dt")+                    nullFormula+                    allRulesets++rdfAxiom09 :: Test+rdfAxiom09 = testEq "rdfAxiom09" "xsd_integer:dt" $+                show (formName rdfAxiomIntDt)++rdfBase09 :: RDFFormula+rdfBase09  = makeFormula scopeex "rdfBase09" $+                "ex:s ex:p \"010\"^^xsd:integer ."+                +rdfStep09a :: RDFProofStep                +rdfStep09a = makeRDFProofStep (getRule "rs_rdfd:r2")+                [rdfAxiomIntDt,rdfBase09]  rdfCons09a+             +rdfCons09a :: RDFFormula+rdfCons09a = makeFormula scopeex "rdfCons09a" $+                "ex:s ex:p \"10\"^^xsd:integer ."+                +rdfStep09b :: RDFProofStep                +rdfStep09b = makeRDFProofStep (getRule "rs_rdf:lg")+                [rdfCons09a]  rdfCons09b+             +rdfCons09b :: RDFFormula+rdfCons09b = makeFormula scopeex "rdfCons09b" $+                "ex:s ex:p _:l ." +++                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ."++rdfStep09c :: RDFProofStep+rdfStep09c = makeRDFProofStep (getRule "rs_rdfd:r1")+                [rdfAxiomIntDt,rdfCons09a,rdfCons09b]  rdfCons09c++rdfCons09c :: RDFFormula+rdfCons09c = makeFormula scopeex "rdfCons09c" $+                "_:l rdf:type xsd:integer ."+                +rdfStep09d :: RDFProofStep                +rdfStep09d = makeRDFProofStep (getRule "rs_rdf:sub")+                [rdfCons09a,rdfCons09b,rdfCons09c]  rdfGoal09+             +rdfGoal09 :: RDFFormula             +rdfGoal09  = makeFormula scopeex "rdfGoal09" $+                "ex:s ex:p  \"10\"^^xsd:integer ."           +++                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." +++                "_:l rdf:type xsd:integer ."++rdfProof09 :: RDFProof+rdfProof09 = makeRDFProof xsdintContext rdfBase09 rdfGoal09+                [ rdfStep09a, rdfStep09b, rdfStep09c, rdfStep09d ]++{- test data+p09t1 = fwdApply (getRule "rs_rdfd:r2")+    [(formExpr rdfAxiomIntDt),(formExpr rdfBase09)]+p09sh = putStrLn ("\n"++showProof "\n" rdfProof09++"\n")+-}+++--  Proof of:+--    ex:s ex:p "abc" .+--    ex:s ex:p "def"^^xsd:string .+--  =>+--    ex:s ex:p "abc"^^xsd:string .+--    ex:s ex:p "def" .+--    xsd:string rdf:type rdfs:Datatype .++rdfAxiomStrDt :: RDFFormula+rdfAxiomStrDt = getContextAxiom+                    (ScopedName (namespaceXsdType "string") "dt")+                    nullFormula+                    allRulesets++rdfAxiom10 :: Test+rdfAxiom10 = testEq "rdfAxiom10" "xsd_string:dt" $+                show (formName rdfAxiomStrDt)++rdfRule10 :: Test+rdfRule10 = testEq "rdfRule10" "xsd_string:ls" $+                show (ruleName (getRule "xsd_string:ls"))++rdfBase10 :: RDFFormula+rdfBase10  = makeFormula scopeex "rdfBase10" $+                "ex:s ex:p \"abc\" . " +++                "ex:s ex:p \"def\"^^xsd:string . "+                +rdfStep10a :: RDFProofStep                +rdfStep10a = makeRDFProofStep (getRule "xsd_string:ls")+                [rdfBase10]  rdfCons10a+             +rdfCons10a :: RDFFormula+rdfCons10a = makeFormula scopeex "rdfCons10a" $+                "ex:s ex:p \"abc\"^^xsd:string . "++rdfStep10b :: RDFProofStep+rdfStep10b = makeRDFProofStep (getRule "xsd_string:sl")+                [rdfBase10]  rdfCons10b++rdfCons10b :: RDFFormula+rdfCons10b = makeFormula scopeex "rdfCons10b" $+                "ex:s ex:p \"def\" . "++rdfStep10c :: RDFProofStep+rdfStep10c = makeRDFProofStep (getRule "rs_rdf:sub")+                [rdfCons10a,rdfCons10b,rdfAxiomStrDt] rdfGoal10++rdfGoal10 :: RDFFormula+rdfGoal10  = makeFormula scopeex "rdfGoal10" $+                "ex:s ex:p \"abc\"^^xsd:string . " +++                "ex:s ex:p \"def\" . "             +++                "xsd:string rdf:type rdfs:Datatype . "++rdfProof10 :: RDFProof+rdfProof10 = makeRDFProof xsdstrContext rdfBase10 rdfGoal10+                [ rdfStep10a, rdfStep10b, rdfStep10c ]++testRdf :: Test+testRdf = TestList+    [ testProofStep "rdfStep01a" True  [(getRule "rs_rdf:r1")] [formExpr rdfBase01] rdfStep01a+    , testProof     "rdfProof01" True  rdfProof01+    --   Really should have support for scoped bnodes+    , testProof     "rdfProof02" True  rdfProof02+    , testProof     "rdfProof03" False rdfProof03+    , testProof     "rdfProof04" True  rdfProof04+    , testProof     "rdfProof05" True  rdfProof05+    , testProof     "rdfProof06" False rdfProof06+    , testProof     "rdfProof07" True  rdfProof07+    , testProof     "rdfProof08" True  rdfProof08+    , rdfAxiom09+    , testProof     "rdfProof09" True  rdfProof09+    , rdfAxiom10, rdfRule10+    , testProof     "rdfProof10" True  rdfProof10+    {-+    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof01)+    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof05)+    -}+    ]++------------------------------------------------------------+--  Full test suite, main program,+--  and useful expressions for interactive use+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testRules+  , testRdf+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT++p10 = runTestTT $ TestList+    [ rdfAxiom10+    , rdfRule10+    , testProof     "rdfProof10" True  rdfProof10+    ]+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFProofTest.hs view
@@ -0,0 +1,1233 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFProofTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module tests the RDFproof module, which instantiates the proof+--  rule class over RDF graphs.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.RDFProof+    ( makeRdfInstanceEntailmentRule+    , makeRdfSubgraphEntailmentRule+    , makeRdfSimpleEntailmentRule+    )++import Swish.RDF.RDFQuery+    ( rdfQueryFind, rdfQuerySubs )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding, RDFVarBindingModify )++import Swish.RDF.RDFRuleset+    ( RDFRule+    , makeRDFGraphFromN3String+    , makeN3ClosureAllocatorRule+    , makeN3ClosureRule+    , makeN3ClosureSimpleRule+    , makeNodeAllocTo+    )++import Swish.RDF.RDFGraph+    ( Label(..), RDFLabel(..), RDFGraph+    , add, allLabels, allNodes )++import Swish.RDF.VarBinding+    ( VarBinding(..) +    , VarBindingModify(..)+    , makeVarFilterModify+    , varBindingId -- , varFilterDisjunction, varFilterConjunction+    , varFilterNE+    )++import Swish.RDF.Rule (Rule(..))++import Swish.Utils.Namespace+    ( Namespace(..), ScopedName(..) )++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertBool, assertEqual+    , runTestTT )++import Data.Maybe (isJust, fromJust)++--  misc helpers++test :: String -> Bool -> Test+test lab tst = TestCase $ assertBool lab tst++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab e a = TestCase $ assertEqual lab e a++testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test+testJe lab e a = TestList+    [ TestCase $ assertBool  lab (isJust a)+    , TestCase $ assertEqual lab e (fromJust a)+    ]++testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test+testJl lab e a = TestList+    [ TestCase $ assertBool  lab   (isJust a)+    , TestCase $ assertEqual lab e (length (fromJust a))+    ]++testNo :: (Eq a, Show a) => String -> [[a]] -> Test+testNo lab a =+    TestCase $ assertBool  lab   (null a)++testIn :: (Eq a, Show a) => String -> a -> [a] -> Test+testIn lab eg a = TestCase $ assertBool lab (eg `elem` a)++--  test1:  simple query with URI, literal and blank nodes.++scope1 :: Namespace+scope1 = Namespace "scope1"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope1"++prefix1 :: String+prefix1 =+    "@prefix ex: <http://example.org/> . \n" +++    " \n"++graph1 :: RDFGraph+graph1    = makeRDFGraphFromN3String graph1str++graph1str :: String+graph1str = prefix1 +++    "ex:s1  ex:p  ex:o1 . \n"  +++    "ex:s2  ex:p  \"lit1\" . \n" +++    "[ ex:p ex:o3 ] . \n"++query11 :: RDFGraph+query11    = makeRDFGraphFromN3String query11str++query11str :: String+query11str = prefix1 +++    "?s  ex:p  ?o . \n"++result11 :: RDFGraph+result11    = makeRDFGraphFromN3String result11str++result11str :: String+result11str = prefix1 +++    "?s  ex:r  ?o . \n"++result11a :: RDFGraph+result11a    = makeRDFGraphFromN3String result11astr++result11astr :: String+result11astr = prefix1 +++    "ex:s1  ex:r  ex:o1    . \n" +++    "ex:s2  ex:r  \"lit1\" . \n" +++    "[ ex:r ex:o3 ]        . \n"++result11b :: RDFGraph+result11b    = makeRDFGraphFromN3String result11bstr++result11bstr :: String+result11bstr = prefix1 +++    "ex:s1  ex:r  ex:o1    . \n"++result11c :: RDFGraph+result11c    = makeRDFGraphFromN3String result11cstr++result11cstr :: String+result11cstr = prefix1 +++    "ex:s2  ex:r  \"lit1\" . \n"++backsub11a :: RDFGraph+backsub11a    = makeRDFGraphFromN3String backsub11astr++backsub11astr :: String+backsub11astr = prefix1 +++    "ex:s1  ex:p  ex:o1    . \n" +++    "ex:s2  ex:p  \"lit1\" . \n"++backsub11b :: RDFGraph+backsub11b    = makeRDFGraphFromN3String backsub11bstr++backsub11bstr :: String+backsub11bstr = prefix1 +++    "ex:s2  ex:p  \"lit1\" . \n"++rul11 :: RDFRule+rul11 = makeN3ClosureSimpleRule scope1 "rul11" query11str result11str++fwd11 :: [RDFGraph]+fwd11 = fwdApply rul11 [graph1]++bwd11 :: [[RDFGraph]]+bwd11 = bwdApply rul11 (add result11b result11c)++test1 :: Test+test1 = +  TestList+  [ testEq "testFwd11" 1 (length fwd11)+  , testIn "testFwd11a" result11a fwd11+  , testEq "testBwd11"  1 (length (head bwd11))+  , testIn "testBwd11a" backsub11a (head bwd11)+  ]++--  test2:  a range of more complex queries based on a+--  single relationship graph.++scope2 :: Namespace+scope2 = Namespace "scope2"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope2"++prefix2 :: String+prefix2 =+    "@prefix pers: <urn:pers:> . \n"      +++    "@prefix rel:  <urn:rel:> . \n"       +++    " \n"++graph2 :: RDFGraph+graph2    = makeRDFGraphFromN3String graph2str++graph2str :: String+graph2str = prefix2 +++    "pers:St1 rel:wife     pers:Do1 ; \n" +++    "         rel:daughter pers:Ma2 ; \n" +++    "         rel:daughter pers:An2 . \n" +++    "pers:Pa2 rel:wife     pers:Ma2 ; \n" +++    "         rel:son      pers:Gr3 ; \n" +++    "         rel:son      pers:La3 ; \n" +++    "         rel:son      pers:Si3 ; \n" +++    "         rel:son      pers:Al3 . \n" +++    "pers:Br2 rel:wife     pers:Ri2 ; \n" +++    "         rel:daughter pers:Ma3 ; \n" +++    "         rel:son      pers:Wi3 . \n" +++    "pers:Gr3 rel:wife     pers:Ma3 ; \n" +++    "         rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Rh4 . \n" +++    "pers:Si3 rel:wife     pers:Jo3 ; \n" +++    "         rel:son      pers:Ol4 ; \n" +++    "         rel:son      pers:Lo4 . \n" +++    "pers:Al3 rel:wife     pers:Su3 ; \n" +++    "         rel:son      pers:Ha4 ; \n" +++    "         rel:son      pers:El4 . \n"++query21 :: RDFGraph+query21    = makeRDFGraphFromN3String query21str++query21str :: String+query21str = prefix2 +++    "?a rel:wife ?b . \n"++result21 :: RDFGraph+result21    = makeRDFGraphFromN3String result21str++result21str :: String+result21str = prefix2 +++    "?b rel:husband ?a . \n"++result21a :: RDFGraph+result21a    = makeRDFGraphFromN3String result21astr++result21astr :: String+result21astr = prefix2 +++    "pers:Do1 rel:husband pers:St1 . \n" +++    "pers:Ma2 rel:husband pers:Pa2 . \n" +++    "pers:Ri2 rel:husband pers:Br2 . \n" +++    "pers:Ma3 rel:husband pers:Gr3 . \n" +++    "pers:Jo3 rel:husband pers:Si3 . \n" +++    "pers:Su3 rel:husband pers:Al3 . \n"++result21b :: RDFGraph+result21b    = makeRDFGraphFromN3String result21bstr++result21bstr :: String+result21bstr = prefix2 +++    "pers:Do1 rel:husband pers:St1 . \n" +++    "pers:Ma2 rel:husband pers:Pa2 . \n"++bwd21a :: RDFGraph+bwd21a    = makeRDFGraphFromN3String bwd21astr++bwd21astr :: String+bwd21astr = prefix2 +++    "pers:St1 rel:wife     pers:Do1 . \n" +++    "pers:Pa2 rel:wife     pers:Ma2 . \n"++rul21 :: RDFRule+rul21 = makeN3ClosureSimpleRule scope2 "rul21" query21str result21str++fwd21 :: [RDFGraph]+fwd21 = fwdApply rul21 [graph2]++bwd21 :: [[RDFGraph]]+bwd21 = bwdApply rul21 result21b++query22 :: RDFGraph+query22    = makeRDFGraphFromN3String query22str++query22str :: String+query22str = prefix2 +++    "?a rel:son ?b . \n" +++    "?b rel:son ?c . \n"++result22 :: RDFGraph+result22    = makeRDFGraphFromN3String result22str++result22str :: String+result22str = prefix2 +++    "?a rel:grandparent ?c . \n"++result22a :: RDFGraph+result22a    = makeRDFGraphFromN3String result22astr++result22astr :: String+result22astr = prefix2 +++    "pers:Pa2 rel:grandparent pers:Ro4 . \n" +++    "pers:Pa2 rel:grandparent pers:Ol4 . \n" +++    "pers:Pa2 rel:grandparent pers:Lo4 . \n" +++    "pers:Pa2 rel:grandparent pers:Ha4 . \n" +++    "pers:Pa2 rel:grandparent pers:El4 . \n"++result22b :: RDFGraph+result22b    = makeRDFGraphFromN3String result22bstr++result22bstr :: String+result22bstr = prefix2 +++    "pers:Pa2 rel:grandparent pers:Ro4 . \n" +++    "pers:Pa2 rel:grandparent pers:Ol4 . \n"++bwd22a :: RDFGraph+bwd22a    = makeRDFGraphFromN3String bwd22astr++bwd22astr :: String+bwd22astr = prefix2 +++    "pers:Pa2 rel:son      _:p1 . \n" +++    "_:p1 rel:son      pers:Ro4 . \n" +++    "pers:Pa2 rel:son      _:p2 . \n" +++    "_:p2 rel:son      pers:Ol4 . \n"++rul22 :: RDFRule+rul22 = makeN3ClosureSimpleRule scope2 "rul22" query22str result22str++fwd22 :: [RDFGraph]+fwd22 = fwdApply rul22 [graph2]++bwd22 :: [[RDFGraph]]+bwd22 = bwdApply rul22 result22b++query23 :: RDFGraph+query23    = makeRDFGraphFromN3String query23str++query23str :: String+query23str = prefix2 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result23 :: RDFGraph+result23    = makeRDFGraphFromN3String result23str++result23str :: String+result23str = prefix2 +++    "?b rel:brother ?c . \n"++result23a :: RDFGraph+result23a    = makeRDFGraphFromN3String result23astr++result23astr :: String+result23astr = prefix2 +++    "pers:Gr3 rel:brother pers:Gr3 . \n" +++    "pers:Gr3 rel:brother pers:La3 . \n" +++    "pers:Gr3 rel:brother pers:Si3 . \n" +++    "pers:Gr3 rel:brother pers:Al3 . \n" +++    "pers:La3 rel:brother pers:Gr3 . \n" +++    "pers:La3 rel:brother pers:La3 . \n" +++    "pers:La3 rel:brother pers:Si3 . \n" +++    "pers:La3 rel:brother pers:Al3 . \n" +++    "pers:Si3 rel:brother pers:Gr3 . \n" +++    "pers:Si3 rel:brother pers:La3 . \n" +++    "pers:Si3 rel:brother pers:Si3 . \n" +++    "pers:Si3 rel:brother pers:Al3 . \n" +++    "pers:Al3 rel:brother pers:Gr3 . \n" +++    "pers:Al3 rel:brother pers:La3 . \n" +++    "pers:Al3 rel:brother pers:Si3 . \n" +++    "pers:Al3 rel:brother pers:Al3 . \n" +++    "pers:Wi3 rel:brother pers:Wi3 . \n" +++    "pers:Ro4 rel:brother pers:Ro4 . \n" +++    "pers:Ol4 rel:brother pers:Lo4 . \n" +++    "pers:Ol4 rel:brother pers:Ol4 . \n" +++    "pers:Lo4 rel:brother pers:Lo4 . \n" +++    "pers:Lo4 rel:brother pers:Ol4 . \n" +++    "pers:Ha4 rel:brother pers:El4 . \n" +++    "pers:Ha4 rel:brother pers:Ha4 . \n" +++    "pers:El4 rel:brother pers:El4 . \n" +++    "pers:El4 rel:brother pers:Ha4 . \n"++result23b :: RDFGraph+result23b    = makeRDFGraphFromN3String result23bstr++result23bstr :: String+result23bstr = prefix2 +++    "pers:Gr3 rel:brother pers:Gr3 . \n" +++    "pers:Gr3 rel:brother pers:La3 . \n"++bwd23a :: RDFGraph+bwd23a    = makeRDFGraphFromN3String bwd23astr++bwd23astr :: String+bwd23astr = prefix2 +++    "_:a1 rel:son pers:Gr3 . \n" +++    "_:a1 rel:son pers:Gr3 . \n" +++    "_:a2 rel:son pers:Gr3 . \n" +++    "_:a2 rel:son pers:La3 . \n"++rul23 :: RDFRule+rul23 = makeN3ClosureSimpleRule scope2 "rul23" query23str result23str++fwd23 :: [RDFGraph]+fwd23 = fwdApply rul23 [graph2]++bwd23 :: [[RDFGraph]]+bwd23 = bwdApply rul23 result23b++--  Test case to return multiple alternative bindings+--+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)+--+--  a stepBrother b if+--      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)++graph24 :: RDFGraph+graph24    = makeRDFGraphFromN3String graph24str++graph24str :: String+graph24str = prefix2 +++    "pers:Ma2 rel:son     pers:Gr3 . \n" +++    "pers:Ma2 rel:stepson pers:St3 . \n"++query24 :: RDFGraph+query24    = makeRDFGraphFromN3String query24str++query24str :: String+query24str = prefix2 +++    "?c rel:son ?a     . \n" +++    "?c rel:stepson ?b . \n"++result24 :: RDFGraph+result24    = makeRDFGraphFromN3String result24str++result24str :: String+result24str = prefix2 +++    "?a rel:stepbrother ?b . \n" +++    "?b rel:stepbrother ?a . \n"++result24a :: RDFGraph+result24a    = makeRDFGraphFromN3String result24astr++result24astr :: String+result24astr = prefix2 +++    "pers:Gr3 rel:stepbrother pers:St3 . \n" +++    "pers:St3 rel:stepbrother pers:Gr3 . \n"++bwd24a1 :: RDFGraph+bwd24a1    = makeRDFGraphFromN3String bwd24a1str++bwd24a1str :: String+bwd24a1str = prefix2 +++    "_:c1 rel:son     pers:Gr3 . \n" +++    "_:c1 rel:stepson pers:St3 . \n" +++    "_:c2 rel:stepson pers:Gr3 . \n" +++    "_:c2 rel:son     pers:St3 . \n"++bwd24a2 :: RDFGraph+bwd24a2    = makeRDFGraphFromN3String bwd24a2str++bwd24a2str :: String+bwd24a2str = prefix2 +++    "_:c1 rel:son     pers:Gr3 . \n" +++    "_:c1 rel:stepson pers:St3 . \n"++bwd24a3 :: RDFGraph+bwd24a3    = makeRDFGraphFromN3String bwd24a3str++bwd24a3str :: String+bwd24a3str = prefix2 +++    "_:c2 rel:stepson pers:Gr3 . \n" +++    "_:c2 rel:son     pers:St3 . \n"++bwd24a4 :: RDFGraph+bwd24a4    = makeRDFGraphFromN3String bwd24a4str++bwd24a4str :: String+bwd24a4str = prefix2 +++    "_:c1 rel:son     pers:Gr3 . \n" +++    "_:c1 rel:stepson pers:St3 . \n" +++    "_:c2 rel:stepson pers:Gr3 . \n" +++    "_:c2 rel:son     pers:St3 . \n"++rul24 :: RDFRule+rul24 = makeN3ClosureSimpleRule scope2 "rul24" query24str result24str++fwd24 :: [RDFGraph]+fwd24 = fwdApply rul24 [graph24]++bwd24 :: [[RDFGraph]]+bwd24 = bwdApply rul24 result24a++--  bwd chain from partial conclusion+--  Also, fail because conclusion is more than the rule+--  can derive from any input.++query25 :: RDFGraph+query25    = makeRDFGraphFromN3String query25str++query25str :: String+query25str = prefix2 +++    "?a rel:son      ?b . \n" +++    "?a rel:daughter ?c . \n"++result25 :: RDFGraph+result25    = makeRDFGraphFromN3String result25str++result25str :: String+result25str = prefix2 +++    "?b rel:sister  ?c . \n" +++    "?c rel:brother ?b . \n"++result25a :: RDFGraph+result25a    = makeRDFGraphFromN3String result25astr++result25astr :: String+result25astr = prefix2 +++    "pers:Wi3 rel:sister  pers:Ma3 . \n" +++    "pers:Ma3 rel:brother pers:Wi3 . \n" +++    "pers:Ro4 rel:sister  pers:Rh4 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n"++{-+result25b    = makeRDFGraphFromN3String result25bstr+result25bstr = prefix2 +++    "pers:Ro4 rel:sister  pers:Rh4 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n"+-}++result25c :: RDFGraph+result25c    = makeRDFGraphFromN3String result25cstr++result25cstr :: String+result25cstr = prefix2 +++    "pers:Wi3 rel:sister  pers:Ma3 . \n" +++    "pers:Ma3 rel:brother pers:Wi3 . \n" +++    "pers:Ro4 rel:sister  pers:Rh4 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n" +++    "pers:xx3 rel:mother  pers:yy3 . \n" +++    "pers:yy3 rel:brother pers:xx3 . \n"++result25d :: RDFGraph+result25d    = makeRDFGraphFromN3String result25dstr++result25dstr :: String+result25dstr = prefix2 +++    "pers:Wi3 rel:sister  pers:Ma3 . \n" +++    "pers:Ma3 rel:brother pers:Wi3 . \n" +++    "pers:Ro4 rel:sister  pers:Rh4 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n" +++    "pers:xx3 rel:father  pers:yy3 . \n"++conc25 :: RDFGraph+conc25    = makeRDFGraphFromN3String conc25str++conc25str :: String+conc25str = prefix2 +++    "pers:Wi3 rel:sister  pers:Ma3 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n"++bwd25a :: RDFGraph+bwd25a    = makeRDFGraphFromN3String bwd25astr++bwd25astr :: String+bwd25astr = prefix2 +++    "_:a1 rel:son      pers:Wi3 . \n" +++    "_:a1 rel:daughter pers:Ma3 . \n" +++    "_:a2 rel:son      pers:Ro4 . \n" +++    "_:a2 rel:daughter pers:Rh4 . \n"++rul25 :: RDFRule+rul25 = makeN3ClosureSimpleRule scope2 "rul25" query25str result25str++fwd25 :: [RDFGraph]+fwd25 = fwdApply rul25 [graph2]++bwd25, bwd25c, bwd25d :: [[RDFGraph]]+bwd25 = bwdApply rul25 conc25+bwd25c = bwdApply rul25 result25c+bwd25d = bwdApply rul25 result25d++test2 :: Test+test2 = +  TestList+  [ testEq "testResult21" 1 (length fwd21)+  , testIn "testResult21a" result21a fwd21+  , testEq "testBwd21"  1 (length $ head bwd21)+  , testIn "testBwd21a" bwd21a (head bwd21)+  , testEq "testResult22" 1 (length fwd22)+  , testIn "testResult22a" result22a fwd22+  , testEq "testBwd22"  1 (length $ head bwd22)+  , testIn "testBwd22a" bwd22a (head bwd22)+  , testEq "testResult23" 1 (length fwd23)+  , testIn "testResult23a" result23a fwd23+  , testEq "testBwd23"  1 (length $ head bwd23)+  , testIn "testBwd23a" bwd23a (head bwd23)+  , testEq "testResult24" 1 (length fwd24)+  , testIn "testResult24a" result24a fwd24+  , testEq "testBwd24"  4 (length bwd24)+  , testIn "testBwd24a1" bwd24a1 (bwd24!!0)+  , testIn "testBwd24a2" bwd24a2 (bwd24!!1)+  , testIn "testBwd24a3" bwd24a3 (bwd24!!2)+  , testIn "testBwd24a4" bwd24a4 (bwd24!!3)+  , testEq "testResult25" 1 (length fwd25)+  , testIn "testResult25a" result25a fwd25+  , testEq "testBwd25"  1 (length $ head bwd25)+  , testIn "testBwd25a" bwd25a (head bwd25)+    -- testBwd25a1 = testEq "testBwd25a" bwd25a (head $ head bwd25)+  , testNo "testBwd25c" bwd25c+  , testNo "testBwd25d" bwd25d+  ]++--  test3:  check variable binding filters++scope3 :: Namespace+scope3 = Namespace "scope3"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope3"++query31 :: RDFGraph+query31    = makeRDFGraphFromN3String query31str++query31str :: String+query31str = prefix2 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++modify31 :: RDFVarBindingModify+modify31 = makeVarFilterModify $ varFilterNE (Var "b") (Var "c")++result31 :: RDFGraph+result31    = makeRDFGraphFromN3String result31str++result31str :: String+result31str = prefix2 +++    "?b rel:brother ?c . \n"++result31a :: RDFGraph+result31a    = makeRDFGraphFromN3String result31astr++result31astr :: String+result31astr = prefix2 +++    "pers:Gr3 rel:brother pers:La3 . \n" +++    "pers:Gr3 rel:brother pers:Si3 . \n" +++    "pers:Gr3 rel:brother pers:Al3 . \n" +++    "pers:La3 rel:brother pers:Gr3 . \n" +++    "pers:La3 rel:brother pers:Si3 . \n" +++    "pers:La3 rel:brother pers:Al3 . \n" +++    "pers:Si3 rel:brother pers:Gr3 . \n" +++    "pers:Si3 rel:brother pers:La3 . \n" +++    "pers:Si3 rel:brother pers:Al3 . \n" +++    "pers:Al3 rel:brother pers:Gr3 . \n" +++    "pers:Al3 rel:brother pers:La3 . \n" +++    "pers:Al3 rel:brother pers:Si3 . \n" +++    "pers:Ol4 rel:brother pers:Lo4 . \n" +++    "pers:Lo4 rel:brother pers:Ol4 . \n" +++    "pers:Ha4 rel:brother pers:El4 . \n" +++    "pers:El4 rel:brother pers:Ha4 . \n"++result31b :: RDFGraph+result31b    = makeRDFGraphFromN3String result31bstr++result31bstr :: String+result31bstr = prefix2 +++    "pers:Gr3 rel:brother pers:Gr3 . \n"++result31c :: RDFGraph+result31c    = makeRDFGraphFromN3String result31cstr++result31cstr :: String+result31cstr = prefix2 +++    "pers:Gr3 rel:brother pers:La3 . \n"++bwd31c :: RDFGraph+bwd31c    = makeRDFGraphFromN3String bwd31cstr++bwd31cstr :: String+bwd31cstr = prefix2 +++    "_:a rel:son pers:Gr3 . \n" +++    "_:a rel:son pers:La3 . \n"++rul31 :: RDFRule+rul31 = makeN3ClosureRule scope3 "rul31" query31str result31str modify31++fwd31 :: [RDFGraph]+fwd31 = fwdApply rul31 [graph2]++calcbwd31b, calcbwd31c :: [[RDFGraph]]+calcbwd31b = bwdApply rul31 result31b+calcbwd31c = bwdApply rul31 result31c++test3 :: Test+test3 = +  TestList+  [ testEq "testResult31" 1 (length fwd31)+  , testIn "testResult31a" result31a fwd31+  , testEq "testBwd31"  0 (length calcbwd31b)+  , testEq "testBwd31"  1 (length $ head calcbwd31c)+  , testIn "testBwd31c" bwd31c (head calcbwd31c)+  ]++--  Instance entailment tests++scope4 :: Namespace+scope4 = Namespace "scope4"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope4"++graph4 :: RDFGraph+graph4    = makeRDFGraphFromN3String graph4str++graph4str :: String+graph4str = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Rh4 . \n"++vocab4 :: [RDFLabel]+vocab4 = allNodes (not . labelIsVar) graph4++name4 :: ScopedName+name4 = ScopedName scope4 "instance4"++rule4 :: RDFRule+rule4 = makeRdfInstanceEntailmentRule name4 vocab4++fwd42a :: RDFGraph+fwd42a    = makeRDFGraphFromN3String fwd42astr++fwd42astr :: String+fwd42astr = prefix2 +++    "pers:Gr3 rel:son      _:Ro4 ;    \n" +++    "         rel:daughter pers:Rh4 . \n"++fwd42b :: RDFGraph+fwd42b    = makeRDFGraphFromN3String fwd42bstr++fwd42bstr :: String+fwd42bstr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 ; \n" +++    "         rel:daughter _:Rh4 .    \n"++fwd42c :: RDFGraph+fwd42c    = makeRDFGraphFromN3String fwd42cstr++fwd42cstr :: String+fwd42cstr = prefix2 +++    "pers:Gr3 rel:son      _:Ro4 ;    \n" +++    "         rel:daughter _:Rh4 .    \n"++fwd42d :: RDFGraph+fwd42d    = makeRDFGraphFromN3String fwd42dstr++fwd42dstr :: String+fwd42dstr = prefix2 +++    "_:Gr3    rel:son      _:Ro4 ;    \n" +++    "         rel:daughter pers:Rh4 . \n"++fwd42e :: RDFGraph+fwd42e    = makeRDFGraphFromN3String fwd42estr++fwd42estr :: String+fwd42estr = prefix2 +++    "_:Gr3    rel:son      _:Ro4 ;    \n" +++    "         rel:daughter pers:Rh4 . \n"++fwd42f :: RDFGraph+fwd42f    = makeRDFGraphFromN3String fwd42fstr++fwd42fstr :: String+fwd42fstr = prefix2 +++    "_:Gr3    rel:son      pers:Ro4 ; \n" +++    "         rel:daughter _:Rh4 .    \n"++fwd42g :: RDFGraph+fwd42g    = makeRDFGraphFromN3String fwd42gstr++fwd42gstr :: String+fwd42gstr = prefix2 +++    "_:Gr3    rel:son      _:Ro4 ;    \n" +++    "         rel:daughter _:Rh4 .    \n"++--  Non-entailments++fwd42w :: RDFGraph+fwd42w    = makeRDFGraphFromN3String fwd42wstr++fwd42wstr :: String+fwd42wstr = prefix2 +++    "pers:Gr3 rel:daughter pers:Ro4 . \n"++fwd42x :: RDFGraph+fwd42x    = makeRDFGraphFromN3String fwd42xstr++fwd42xstr :: String+fwd42xstr = prefix2 +++    "pers:Gr3 rel:daughter pers:Ro4 . \n"++fwd42y :: RDFGraph+fwd42y    = makeRDFGraphFromN3String fwd42ystr++fwd42ystr :: String+fwd42ystr = prefix2 +++    "_:Gr3    rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Ro4 . \n"++fwd42z :: RDFGraph+fwd42z    = makeRDFGraphFromN3String fwd42zstr++fwd42zstr :: String+fwd42zstr = prefix2 +++    "_:Gr3    rel:son      _:Ro4 ; \n" +++    "         rel:son      _:Rh4 . \n"++bwd43 :: RDFGraph+bwd43 = makeRDFGraphFromN3String bwd43str++bwd43str :: String+bwd43str = prefix2 +++    "_:a1 rel:son      pers:Ro4 . \n" +++    "_:a2 rel:daughter pers:Rh4 . \n"++bwd43a :: RDFGraph+bwd43a = makeRDFGraphFromN3String bwd43astr++bwd43astr :: String+bwd43astr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n" +++    "pers:Gr3 rel:daughter pers:Rh4 . \n"++bwd43b :: RDFGraph+bwd43b = makeRDFGraphFromN3String bwd43bstr++bwd43bstr :: String+bwd43bstr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n" +++    "pers:Ro4 rel:daughter pers:Rh4 . \n"++bwd43c :: RDFGraph+bwd43c = makeRDFGraphFromN3String bwd43cstr++bwd43cstr :: String+bwd43cstr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n" +++    "pers:Rh4 rel:daughter pers:Rh4 . \n"++bwd43d :: RDFGraph+bwd43d = makeRDFGraphFromN3String bwd43dstr++bwd43dstr :: String+bwd43dstr = prefix2 +++    "pers:Ro4 rel:son      pers:Ro4 . \n" +++    "pers:Gr3 rel:daughter pers:Rh4 . \n"++bwd43e :: RDFGraph+bwd43e = makeRDFGraphFromN3String bwd43estr++bwd43estr :: String+bwd43estr = prefix2 +++    "pers:Ro4 rel:son      pers:Ro4 . \n" +++    "pers:Ro4 rel:daughter pers:Rh4 . \n"++bwd43f :: RDFGraph+bwd43f = makeRDFGraphFromN3String bwd43fstr++bwd43fstr :: String+bwd43fstr = prefix2 +++    "pers:Ro4 rel:son      pers:Ro4 . \n" +++    "pers:Rh4 rel:daughter pers:Rh4 . \n"++bwd43g :: RDFGraph+bwd43g = makeRDFGraphFromN3String bwd43gstr++bwd43gstr :: String+bwd43gstr = prefix2 +++    "pers:Rh4 rel:son      pers:Ro4 . \n" +++    "pers:Gr3 rel:daughter pers:Rh4 . \n"++bwd43h :: RDFGraph+bwd43h = makeRDFGraphFromN3String bwd43hstr++bwd43hstr :: String+bwd43hstr = prefix2 +++    "pers:Rh4 rel:son      pers:Ro4 . \n" +++    "pers:Ro4 rel:daughter pers:Rh4 . \n"++bwd43i :: RDFGraph+bwd43i = makeRDFGraphFromN3String bwd43istr++bwd43istr :: String+bwd43istr = prefix2 +++    "pers:Rh4 rel:son      pers:Ro4 . \n" +++    "pers:Rh4 rel:daughter pers:Rh4 . \n"++--  Forward chaining++fwdApply42 :: [RDFGraph]+fwdApply42      = fwdApply rule4 [graph4]++--  Backward chaining++bwdApply43 :: [[RDFGraph]]+bwdApply43      = bwdApply rule4 bwd43++test4 :: Test+test4 = +  TestList+  [ +    --  Check basics+    testEq "testRuleName41" name4 (ruleName rule4)+  , testEq "testVocab41"    3     (length vocab4)+  , testEq "testFwdLength42" 7 (length fwdApply42)+  , testIn "testFwdApply42a"  fwd42a fwdApply42+  , testIn "testFwdApply42b"  fwd42b fwdApply42+  , testIn "testFwdApply42c"  fwd42c fwdApply42+  , testIn "testFwdApply42d"  fwd42d fwdApply42+  , testIn "testFwdApply42e"  fwd42e fwdApply42+  , testIn "testFwdApply42f"  fwd42f fwdApply42+  , testIn "testFwdApply42g"  fwd42g fwdApply42+  , testEq "testBwdLength43" 9 (length bwdApply43)+  , testIn "testBwdApply43a"  [bwd43a] bwdApply43+  , testIn "testBwdApply43b"  [bwd43b] bwdApply43+  , testIn "testBwdApply43c"  [bwd43c] bwdApply43+  , testIn "testBwdApply43d"  [bwd43d] bwdApply43+  , testIn "testBwdApply43e"  [bwd43e] bwdApply43+  , testIn "testBwdApply43f"  [bwd43f] bwdApply43+  , testIn "testBwdApply43g"  [bwd43g] bwdApply43+  , testIn "testBwdApply43h"  [bwd43h] bwdApply43+  , testIn "testBwdApply43i"  [bwd43i] bwdApply43+      +    --  Entailment checks+  , testEq "testEntail44a" True  (checkInference rule4 [graph4] fwd42a)+  , testEq "testEntail44b" True  (checkInference rule4 [graph4] fwd42b)+  , testEq "testEntail44g" True  (checkInference rule4 [graph4] fwd42g)+  , testEq "testEntail44w" False (checkInference rule4 [graph4] fwd42w)+  , testEq "testEntail44x" False (checkInference rule4 [graph4] fwd42x)+  , testEq "testEntail44y" False (checkInference rule4 [graph4] fwd42y)+  , testEq "testEntail44z" False (checkInference rule4 [graph4] fwd42z)+  ]++--  Subgraph entailment tests++scope5 :: Namespace+scope5 = Namespace "scope5"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope5"++graph5 :: RDFGraph+graph5    = makeRDFGraphFromN3String graph5str++graph5str :: String+graph5str = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Rh4 . \n" +++    "pers:Si3 rel:son      pers:Ol4 . \n"++name5 :: ScopedName+name5 = ScopedName scope5 "subgraph5"++rule5 :: RDFRule+rule5 = makeRdfSubgraphEntailmentRule name5++--  Forward chaining excludes null agraph and copy of antecedent++fwd52a :: RDFGraph+fwd52a    = makeRDFGraphFromN3String fwd52astr++fwd52astr :: String+fwd52astr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n"++fwd52b :: RDFGraph+fwd52b    = makeRDFGraphFromN3String fwd52bstr++fwd52bstr :: String+fwd52bstr = prefix2 +++    "pers:Gr3 rel:daughter pers:Rh4 . \n"++fwd52c :: RDFGraph+fwd52c    = makeRDFGraphFromN3String fwd52cstr++fwd52cstr :: String+fwd52cstr = prefix2 +++    "pers:Si3 rel:son      pers:Ol4 . \n"++fwd52d :: RDFGraph+fwd52d    = makeRDFGraphFromN3String fwd52dstr++fwd52dstr :: String+fwd52dstr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n" +++    "pers:Gr3 rel:daughter pers:Rh4 . \n"++fwd52e :: RDFGraph+fwd52e    = makeRDFGraphFromN3String fwd52estr++fwd52estr :: String+fwd52estr = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 . \n" +++    "pers:Si3 rel:son      pers:Ol4 . \n"++fwd52f :: RDFGraph+fwd52f    = makeRDFGraphFromN3String fwd52fstr++fwd52fstr :: String+fwd52fstr = prefix2 +++    "pers:Gr3 rel:daughter pers:Rh4 . \n" +++    "pers:Si3 rel:son      pers:Ol4 . \n"+++--  Forward chaining++fwdApply52 :: [RDFGraph]+fwdApply52      = fwdApply rule5 [graph5]++test5 :: Test+test5 = +  TestList+  [ testEq "testRuleName51" name5 (ruleName rule5)+  , testEq "testFwdLength52" 6 (length fwdApply52)+  , testIn "testFwdApply52a"  fwd52a fwdApply52+  , testIn "testFwdApply52b"  fwd52b fwdApply52+  , testIn "testFwdApply52c"  fwd52c fwdApply52+  , testIn "testFwdApply52d"  fwd52d fwdApply52+  , testIn "testFwdApply52e"  fwd52e fwdApply52+  , testIn "testFwdApply52f"  fwd52f fwdApply52+  ]++--  Simple entailment test+--  Simple entailment provides entailment check only, no forward or+--  backward chaining.  For that use instance- and subgraph- rules.++scope6 :: Namespace+scope6 = Namespace "scope6"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope6"++graph6 :: RDFGraph+graph6    = makeRDFGraphFromN3String graph6str++graph6str :: String+graph6str = prefix2 +++    "pers:Gr3 rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Rh4 . \n" +++    "pers:Si3 rel:son      pers:Ol4 ; \n" +++    "         rel:son      pers:Lo4 . \n"++name6 :: ScopedName+name6 = ScopedName scope5 "subgraph6"++rule6 :: RDFRule+rule6 = makeRdfSimpleEntailmentRule name6++simple6a :: RDFGraph+simple6a    = makeRDFGraphFromN3String simple6astr++simple6astr :: String+simple6astr = prefix2 +++    "_:Gr3 rel:son      pers:Ro4 ; \n" +++    "      rel:daughter pers:Rh4 . \n"++simple6b :: RDFGraph+simple6b    = makeRDFGraphFromN3String simple6bstr++simple6bstr :: String+simple6bstr = prefix2 +++    "_:Si3 rel:son      pers:Ol4 ; \n" +++    "      rel:son      pers:Lo4 . \n"++simple6c :: RDFGraph+simple6c    = makeRDFGraphFromN3String simple6cstr++simple6cstr :: String+simple6cstr = prefix2 +++    "_:Si3 rel:son      _:Ol4 ; \n" +++    "      rel:son      _:Lo4 . \n"++simple6d :: RDFGraph+simple6d    = makeRDFGraphFromN3String simple6dstr++simple6dstr :: String+simple6dstr = prefix2 +++    "_:Si3 rel:son      _:Ol4 ; \n" +++    "      rel:daughter _:Lo4 . \n"++simple6e :: RDFGraph+simple6e    = makeRDFGraphFromN3String simple6estr++simple6estr :: String+simple6estr = prefix2 +++    "_:Si3 rel:daughter _:Ol4 ; \n" +++    "      rel:mother   _:Lo4 . \n"++test6 :: Test+test6 = +  TestList+  [ testEq "testRuleName61" name6 (ruleName rule6)+  , test "testSimple62" (checkInference rule6 [graph6] simple6a)+  , test "testSimple63" (checkInference rule6 [graph6] simple6b)+  , test "testSimple64" (checkInference rule6 [graph6] simple6c)+  , test "testSimple65" (checkInference rule6 [graph6] simple6d)+  , test "testSimple66" (not $ checkInference rule6 [graph6] simple6e)+  , test "testFwd64"    (null $ fwdApply rule6 [graph6])+  , test "testBwd65"    (null $ bwdApply rule6 graph6)+  ]++--  Test forward chaining node allocation logic+--+--  ?a uncle ?c => ?a father ?b, ?b brother ?c,   ?b allocTo ?a+--+--    Ro4 uncle La3, Ro4 uncle Si3, Rh4 uncle La3, Rh4 uncle Si3+--  =>+--    Ro4 father _:f1, _:f1 brother La3,+--    Ro4 father _:f1, _:f1 brother Si3,+--    Rh4 father _:f2, _:f2 brother La3,+--    Rh4 father _:f2, _:f2 brother Si3++scope7 :: Namespace+scope7 = Namespace "scope7"+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope7"++graph7 :: RDFGraph+graph7    = makeRDFGraphFromN3String graph7str++graph7str :: String+graph7str = prefix2 +++    "pers:Ro4 rel:uncle pers:La3 ; \n" +++    "         rel:uncle pers:Si3 . \n" +++    "pers:Rh4 rel:uncle pers:La3 ; \n" +++    "         rel:uncle pers:Si3 . \n"++query71 :: RDFGraph+query71    = makeRDFGraphFromN3String query71str++query71str :: String+query71str = prefix2 +++    "?a rel:uncle ?c . \n"++result71 :: RDFGraph+result71    = makeRDFGraphFromN3String result71str++result71str :: String+result71str = prefix2 +++    "?a rel:father  ?b . \n" +++    "?b rel:brother ?c . \n"++result71a :: RDFGraph+result71a    = makeRDFGraphFromN3String result71astr++result71astr :: String+result71astr = prefix2 +++    "pers:Ro4 rel:father  _:f1     . \n" +++    "_:f1     rel:brother pers:La3 . \n" +++    "pers:Ro4 rel:father  _:f1     . \n" +++    "_:f1     rel:brother pers:Si3 . \n" +++    "pers:Rh4 rel:father  _:f2     . \n" +++    "_:f2     rel:brother pers:La3 . \n" +++    "pers:Rh4 rel:father  _:f2     . \n" +++    "_:f2     rel:brother pers:Si3 . \n"++rul71 :: RDFRule+rul71 = makeN3ClosureAllocatorRule scope7 "rul71"+    query71str result71str varBindingId mod71++mod71 :: [RDFLabel] -> RDFVarBindingModify+mod71 = makeNodeAllocTo (Var "b") (Var "a")++var71 :: [RDFVarBinding]+var71      = rdfQueryFind query71 graph7++var71a :: [VarBinding RDFLabel RDFLabel]+var71a     = vbmApply (mod71 (allLabels labelIsVar graph7)) var71++var71_1 :: VarBinding RDFLabel RDFLabel+var71_1    = head var71a++map71a, map71b, map71c :: Maybe RDFLabel+map71a     = Just (Var "#a")+map71b     = Just (Var "#b")+map71c     = Just (Var "#c")++sub71a :: [RDFGraph]+sub71a     = rdfQuerySubs var71a result71++fwd71 :: [RDFGraph]+fwd71 = fwdApply rul71 [graph7]++test7 :: Test+test7 = +  TestList+  [ testEq "testVar71" 4 (length var71)+  , testEq "testVar71a" 4 (length var71a)+-- testVar71_1a = testEq "testVar71_1a" map71a ( vbMap var71_1 (Var "a"))+-- testVar71_1b = testEq "testVar71_1b" map71b ( vbMap var71_1 (Var "b"))+-- testVar71_1c = testEq "testVar71_1c" map71c ( vbMap var71_1 (Var "c"))+  , testEq "testVar71a" 4 (length sub71a)+  , testEq "testResult71" 1 (length fwd71)+  , testIn "testResult71a" result71a fwd71+  ]    ++--  Full test suite, main program, and useful expressions for interactive use++allTests :: Test+allTests = TestList+  [ test1+  , test2+  , test3+  , test4+  , test5+  , test6+  , test7+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFQueryTest.hs view
@@ -0,0 +1,1679 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFQueryTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module defines test cases for querying an RDF graph to obtain+--  a set of variable substitutions, and to apply a set of variable+--  substitutions to a query pattern to obtain a new graph.+--+--  It also tests some primitive graph access functions.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.RDFQuery+    ( rdfQueryFind, rdfQueryFilter+    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify+    , rdfQueryInstance+    , rdfQuerySubs, rdfQueryBackSubs+    , rdfQuerySubsAll+    , rdfQuerySubsBlank, rdfQueryBackSubsBlank+    -- debug+    )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding+    , RDFVarBindingFilter+    , rdfVarBindingUriRef, rdfVarBindingBlank+    , rdfVarBindingLiteral+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped+    , rdfVarBindingMemberProp+    )++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , merge+    )++import Swish.RDF.VarBinding+    ( VarBinding(..)+    , makeVarBinding+    , joinVarBindings+    , VarBindingModify(..)+    , makeVarFilterModify+    , varBindingId+    , varFilterNE+    )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    , makeScopedName+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , langName+    , swishName+    , rdf_type, rdf_XMLLiteral+    )++import Swish.RDF.N3Parser (parseN3fromString)++import Swish.Utils.ListHelpers (equiv)++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertBool, assertEqual+    , runTestTT )++------------------------------------------------------------+--  misc helpers+------------------------------------------------------------++newtype Set a = Set [a] deriving Show++instance (Eq a) => Eq (Set a) where+    Set v1 == Set v2 = v1 `equiv` v2++test :: String -> Bool -> Test+test lab tst = TestCase $ assertBool lab tst++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab e a = TestCase $ assertEqual lab e a++testLs :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testLs lab e a = TestCase $ assertEqual lab (Set e) (Set a)++testGr :: String -> String -> [RDFGraph] -> Test+testGr lab e a = TestCase $ assertBool lab (eg `elem` a)+    where eg = graphFromString e++graphFromString :: String -> RDFGraph+graphFromString str = case parseN3fromString str of+    Right gr -> gr+    Left msg -> error msg++-- Compare lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+    show (ListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++------------------------------------------------------------+--  test1:  simple query qith URI, literal and blank nodes.+------------------------------------------------------------++prefix1 :: String+prefix1 =+    "@prefix ex: <http://example.org/> . \n" +++    " \n"++graph1 :: RDFGraph+graph1 = graphFromString $ prefix1 +++         "ex:s1  ex:p  ex:o1 . \n"  +++         "ex:s2  ex:p  \"lit1\" . \n" +++         "[ ex:p ex:o3 ] . \n"++query11 :: RDFGraph+query11    = graphFromString $ prefix1 +++             "?s  ex:p  ?o . \n"++result11 :: RDFGraph+result11    = graphFromString $ prefix1 +++              "?s  ex:r  ?o . \n"++result11a, result11b, result11c :: String++result11a = prefix1 ++ "ex:s1  ex:r  ex:o1 . \n"+result11b = prefix1 ++ "ex:s2  ex:r  \"lit1\" . \n"+result11c = prefix1 ++ "[ ex:r ex:o3 ] . \n"++var11 :: [RDFVarBinding]+var11 = rdfQueryFind query11 graph1++res11 :: [RDFGraph]+res11 = rdfQuerySubs var11 result11++test1 :: Test+test1 = +  TestList+  [ test "testQuery11" (not $ null var11)+  , testEq "testResult11" 3 (length res11)+  , testGr "testResult11a" result11a res11+  , testGr "testResult11b" result11b res11+  , testGr "testResult11c" result11c res11+  ]+  +------------------------------------------------------------+--  test2:  a range of more complex queries based on a+--  single relationship graph.+------------------------------------------------------------++prefix2 :: String+prefix2 =+    "@prefix pers: <urn:pers:> . \n"      +++    "@prefix rel:  <urn:rel:> . \n"       +++    " \n"++graph2 :: RDFGraph+graph2 = graphFromString $ prefix2 +++    "pers:St1 rel:wife     pers:Do1 ; \n" +++    "         rel:daughter pers:Ma2 ; \n" +++    "         rel:daughter pers:An2 . \n" +++    "pers:Pa2 rel:wife     pers:Ma2 ; \n" +++    "         rel:son      pers:Gr3 ; \n" +++    "         rel:son      pers:La3 ; \n" +++    "         rel:son      pers:Si3 ; \n" +++    "         rel:son      pers:Al3 . \n" +++    "pers:Br2 rel:wife     pers:Ri2 ; \n" +++    "         rel:daughter pers:Ma3 ; \n" +++    "         rel:son      pers:Wi3 . \n" +++    "pers:Gr3 rel:wife     pers:Ma3 ; \n" +++    "         rel:son      pers:Ro4 ; \n" +++    "         rel:daughter pers:Rh4 . \n" +++    "pers:Si3 rel:wife     pers:Jo3 ; \n" +++    "         rel:son      pers:Ol4 ; \n" +++    "         rel:son      pers:Lo4 . \n" +++    "pers:Al3 rel:wife     pers:Su3 ; \n" +++    "         rel:son      pers:Ha4 ; \n" +++    "         rel:son      pers:El4 . \n"++query21 :: RDFGraph+query21 = graphFromString $ prefix2 +++    "?a rel:wife ?b . \n"++result21 :: RDFGraph+result21 = graphFromString $ prefix2 +++    "?b rel:husband ?a . \n"++result21a, result21b, result21c, result21d,+  result21e, result21f :: String++result21a = prefix2 ++ "pers:Do1 rel:husband pers:St1 . \n"+result21b = prefix2 ++ "pers:Ma2 rel:husband pers:Pa2 . \n"+result21c = prefix2 ++ "pers:Ri2 rel:husband pers:Br2 . \n"+result21d = prefix2 ++ "pers:Ma3 rel:husband pers:Gr3 . \n"+result21e = prefix2 ++ "pers:Jo3 rel:husband pers:Si3 . \n"+result21f = prefix2 ++ "pers:Su3 rel:husband pers:Al3 . \n"++var21 :: [RDFVarBinding]+var21         = rdfQueryFind query21 graph2++res21 :: [RDFGraph]+res21         = rdfQuerySubs var21 result21++query22 :: RDFGraph+query22    = graphFromString $ prefix2 +++    "?a rel:son ?b . \n" +++    "?b rel:son ?c . \n"++result22 :: RDFGraph+result22    = graphFromString $ prefix2 +++    "?a rel:grandparent ?c . \n"++result22a :: String+result22a = prefix2 +++    "pers:Pa2 rel:grandparent pers:Ro4 . \n"++result22b :: String+result22b = prefix2 +++    "pers:Pa2 rel:grandparent pers:Ol4 . \n"++result22c :: String+result22c = prefix2 +++    "pers:Pa2 rel:grandparent pers:Lo4 . \n"++result22d :: String+result22d = prefix2 +++    "pers:Pa2 rel:grandparent pers:Ha4 . \n"++result22e :: String+result22e = prefix2 +++    "pers:Pa2 rel:grandparent pers:El4 . \n"++var22 :: [RDFVarBinding]+var22         = rdfQueryFind query22 graph2++res22 :: [RDFGraph]+res22         = rdfQuerySubs var22 result22++query23 :: RDFGraph+query23    = graphFromString $ prefix2 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result23 :: RDFGraph+result23    = graphFromString $ prefix2 +++    "?b rel:brother ?c . \n"++result23a, result23b, result23c, result23d,+  result23e, result23f, result23g, result23h,+  result23i, result23j, result23k, result23l,+  result23m, result23n, result23o, result23p,+  result23q, result23r, result23s, result23t,+  result23u, result23v, result23w, result23x,+  result23y, result23z :: String++result23a = prefix2 +++    "pers:Gr3 rel:brother pers:Gr3 . \n"++result23b = prefix2 +++    "pers:Gr3 rel:brother pers:La3 . \n"++result23c = prefix2 +++    "pers:Gr3 rel:brother pers:Si3 . \n"++result23d = prefix2 +++    "pers:Gr3 rel:brother pers:Al3 . \n"++result23e = prefix2 +++    "pers:La3 rel:brother pers:Gr3 . \n"++result23f = prefix2 +++    "pers:La3 rel:brother pers:La3 . \n"++result23g = prefix2 +++    "pers:La3 rel:brother pers:Si3 . \n"++result23h = prefix2 +++    "pers:La3 rel:brother pers:Al3 . \n"++result23i = prefix2 +++    "pers:Si3 rel:brother pers:Gr3 . \n"++result23j = prefix2 +++    "pers:Si3 rel:brother pers:La3 . \n"++result23k = prefix2 +++    "pers:Si3 rel:brother pers:Si3 . \n"++result23l = prefix2 +++    "pers:Si3 rel:brother pers:Al3 . \n"++result23m = prefix2 +++    "pers:Al3 rel:brother pers:Gr3 . \n"++result23n = prefix2 +++    "pers:Al3 rel:brother pers:La3 . \n"++result23o = prefix2 +++    "pers:Al3 rel:brother pers:Si3 . \n"++result23p = prefix2 +++    "pers:Al3 rel:brother pers:Al3 . \n"++result23q = prefix2 +++    "pers:Wi3 rel:brother pers:Wi3 . \n"++result23r = prefix2 +++    "pers:Ro4 rel:brother pers:Ro4 . \n"++result23s = prefix2 +++    "pers:Ol4 rel:brother pers:Lo4 . \n"++result23t = prefix2 +++    "pers:Ol4 rel:brother pers:Ol4 . \n"++result23u = prefix2 +++    "pers:Lo4 rel:brother pers:Lo4 . \n"++result23v = prefix2 +++    "pers:Lo4 rel:brother pers:Ol4 . \n"++result23w = prefix2 +++    "pers:Ha4 rel:brother pers:El4 . \n"++result23x = prefix2 +++    "pers:Ha4 rel:brother pers:Ha4 . \n"++result23y = prefix2 +++    "pers:El4 rel:brother pers:El4 . \n"++result23z = prefix2 +++    "pers:El4 rel:brother pers:Ha4 . \n"++var23 :: [RDFVarBinding]+var23 = rdfQueryFind query23 graph2++res23 :: [RDFGraph]+res23 = rdfQuerySubs var23 result23++-- apply filtering to result:++filter23 :: RDFVarBindingFilter+filter23 = varFilterNE (Var "b") (Var "c")++var23F :: [RDFVarBinding]+var23F   = rdfQueryFilter filter23 var23++res23F :: [RDFGraph]+res23F   = rdfQuerySubs var23F result23++query24 :: RDFGraph+query24    = graphFromString $ prefix2 +++    "?a rel:daughter ?b . \n" +++    "?a rel:daughter ?c . \n"++result24 :: RDFGraph+result24    = graphFromString $ prefix2 +++    "?b rel:sister ?c . \n"++result24a, result24b, result24c, result24d,+  result24e, result24f :: String+ +result24a = prefix2 +++    "pers:Ma2 rel:sister pers:Ma2 . \n"++result24b = prefix2 +++    "pers:Ma2 rel:sister pers:An2 . \n"++result24c = prefix2 +++    "pers:An2 rel:sister pers:Ma2 . \n"++result24d = prefix2 +++    "pers:An2 rel:sister pers:An2 . \n"++result24e = prefix2 +++    "pers:Ma3 rel:sister pers:Ma3 . \n"++result24f = prefix2 +++    "pers:Rh4 rel:sister pers:Rh4 . \n"++var24 :: [RDFVarBinding]+var24 = rdfQueryFind query24 graph2++res24 :: [RDFGraph]+res24 = rdfQuerySubs var24 result24++query25 :: RDFGraph+query25    = graphFromString $ prefix2 +++    "?a rel:son      ?b . \n" +++    "?a rel:daughter ?c . \n"++result25 :: RDFGraph+result25    = graphFromString $ prefix2 +++    "?b rel:sister  ?c . \n" +++    "?c rel:brother ?b . \n"++result25a, result25b :: String+result25a = prefix2 +++    "pers:Wi3 rel:sister  pers:Ma3 . \n" +++    "pers:Ma3 rel:brother pers:Wi3 . \n"++result25b = prefix2 +++    "pers:Ro4 rel:sister  pers:Rh4 . \n" +++    "pers:Rh4 rel:brother pers:Ro4 . \n"++var25 :: [RDFVarBinding]+var25 = rdfQueryFind query25 graph2++res25 :: [RDFGraph]+res25 = rdfQuerySubs var25 result25++test2 :: Test+test2 =+  TestList+  [ test "testQuery21" (not $ null var21)+  , testEq "testResult21" 6 (length res21)+  , testGr "testResult21a" result21a res21+  , testGr "testResult21b" result21b res21+  , testGr "testResult21c" result21c res21+  , testGr "testResult21d" result21d res21+  , testGr "testResult21e" result21e res21+  , testGr "testResult21f" result21f res21+  , test "testQuery22" (not $ null var22)+  , testEq "testResult22" 5 (length res22)+  , testGr "testResult22a" result22a res22+  , testGr "testResult22b" result22b res22+  , testGr "testResult22c" result22c res22+  , testGr "testResult22d" result22d res22+  , testGr "testResult22e" result22e res22+  , test "testQuery23" (not $ null var23)+  , testEq "testResult23" 26 (length res23)+  , testGr "testResult23a" result23a res23+  , testGr "testResult23b" result23b res23+  , testGr "testResult23c" result23c res23+  , testGr "testResult23d" result23d res23+  , testGr "testResult23e" result23e res23+  , testGr "testResult23f" result23f res23+  , testGr "testResult23g" result23g res23+  , testGr "testResult23h" result23h res23+  , testGr "testResult23i" result23i res23+  , testGr "testResult23j" result23j res23+  , testGr "testResult23k" result23k res23+  , testGr "testResult23l" result23l res23+  , testGr "testResult23m" result23m res23+  , testGr "testResult23n" result23n res23+  , testGr "testResult23o" result23o res23+  , testGr "testResult23p" result23p res23+  , testGr "testResult23q" result23q res23+  , testGr "testResult23r" result23r res23+  , testGr "testResult23s" result23s res23+  , testGr "testResult23t" result23t res23+  , testGr "testResult23u" result23u res23+  , testGr "testResult23v" result23v res23+  , testGr "testResult23w" result23w res23+  , testGr "testResult23x" result23x res23+  , testGr "testResult23y" result23y res23+  , testGr "testResult23z" result23z res23+  , testEq "testResult23" 16 (length res23F)+  , testGr "testResult23b" result23b res23F+  , testGr "testResult23c" result23c res23F+  , testGr "testResult23d" result23d res23F+  , testGr "testResult23e" result23e res23F+  , testGr "testResult23g" result23g res23F+  , testGr "testResult23h" result23h res23F+  , testGr "testResult23i" result23i res23F+  , testGr "testResult23j" result23j res23F+  , testGr "testResult23l" result23l res23F+  , testGr "testResult23m" result23m res23F+  , testGr "testResult23n" result23n res23F+  , testGr "testResult23o" result23o res23F+  , testGr "testResult23s" result23s res23F+  , testGr "testResult23v" result23v res23F+  , testGr "testResult23w" result23w res23F+  , testGr "testResult23z" result23z res23F+  , test "testQuery24" (not $ null var24)+  , testEq "testResult24" 6 (length res24)+  , testGr "testResult24a" result24a res24+  , testGr "testResult24b" result24b res24+  , testGr "testResult24c" result24c res24+  , testGr "testResult24d" result24d res24+  , testGr "testResult24e" result24e res24+  , testGr "testResult24f" result24f res24+    +  , test "testQuery25" (not $ null var25)+  , testEq "testResult25" 2 (length res25)+  , testGr "testResult25a" result25a res25+  , testGr "testResult25b" result25b res25+  ]++------------------------------------------------------------+--  test handling of unsubstituted variables, and+--  rdfQuerySubsAll, rdfQuerySubsBlank+------------------------------------------------------------++graph3 :: RDFGraph+graph3 = graphFromString $ prefix2 +++    "pers:Pa2 rel:grandparent pers:Ro4 . \n" +++    "pers:Pa2 rel:grandparent pers:Ol4 . \n"++query31 :: RDFGraph+query31 = graphFromString $ prefix2 +++    "?a rel:grandparent ?c . \n"++result31 :: RDFGraph+result31 = graphFromString $ prefix2 +++    "?a rel:son ?b . \n" +++    "?b rel:son ?c . \n"++result31a, result31b :: String+result31a = prefix2 +++    "pers:Pa2 rel:son ?b . \n" +++    "?b rel:son pers:Ro4 . \n"++result31b = prefix2 +++    "pers:Pa2 rel:son ?b . \n" +++    "?b rel:son pers:Ol4 . \n"++var31 :: [RDFVarBinding]+var31 = rdfQueryFind query31 graph3++res31pairs :: [(RDFGraph, [RDFLabel])]+res31pairs = rdfQuerySubsAll var31 result31++res31 :: [RDFGraph]+res31v :: [[RDFLabel]]+(res31,res31v) = unzip res31pairs++query32 :: RDFGraph+query32 = graphFromString $ prefix2 +++    "?a rel:grandparent ?c . \n"++result32 :: RDFGraph+result32 = graphFromString $ prefix2 +++    "?a rel:wife _:b  . \n" +++    "?d rel:any  _:b0 . \n" +++    "?a rel:son ?b . \n"    +++    "?b rel:son ?c . \n"++result32a, result32b :: String+result32a = prefix2 +++    "pers:Pa2 rel:wife _:b      . \n" +++    "_:d0     rel:any  _:b0     . \n" +++    "pers:Pa2 rel:son  _:b1     . \n" +++    "_:b1     rel:son  pers:Ro4 . \n"++result32b = prefix2 +++    "pers:Pa2 rel:wife _:b      . \n" +++    "_:d0     rel:any  _:b0     . \n" +++    "pers:Pa2 rel:son  _:b1     . \n" +++    "_:b1     rel:son  pers:Ol4 . \n"++res32, res33 :: [RDFGraph]+res32 = rdfQuerySubsBlank var31 result32+res33 = rdfQuerySubs var31 result32++test3 :: Test+test3 = +  TestList+  [ test "testQuery31" (not $ null var31)+  , testEq "testUnsubs31" 2 (length res31v)+  , testEq "testUnsubs31a" [(Var "b")] (head res31v)+  , testEq "testUnsubs31a" [(Var "b")] (head . tail $ res31v)+  , testEq "testResult31" 2 (length res31)+  , testGr "testResult31a" result31a res31+  , testGr "testResult31b" result31b res31+  , testEq "testResult32" 2 (length res32)+  , testGr "testResult32a" result32a res32+  , testGr "testResult32b" result32b res32+  , testEq "testResult33" 0 (length res33)+  ]++{-+--  Debug sequence for rdfQuerySubsBlank+--  (using internals of rdfQuerySubsBlank implementation)+--  res32 = rdfQuerySubsBlank (fromJust var31) result32+d1 = result32+d2 = rdfQuerySubs2 (head $ var31) d1+d3 = allLabels isBlank (fst d2)+d4 = remapLabels (snd d2) d3 makeBlank (fst d2)+-}++------------------------------------------------------------+--  test4:  test of backward-chaining query+------------------------------------------------------------++prefix4 :: String+prefix4 =+    "@prefix pers: <urn:pers:> . \n"      +++    "@prefix rel:  <urn:rel:> . \n"       +++    " \n"++graph41 :: RDFGraph+graph41 = graphFromString $ prefix4 +++    "pers:St1 rel:wife     pers:Do1 . \n"++query41 :: RDFGraph+query41 = graphFromString $ prefix4 +++    "?a rel:wife ?b . \n"++result41 :: RDFGraph+result41 = graphFromString $ prefix4 +++    "?b rel:husband ?a . \n"++result41a :: String+result41a = prefix4 +++    "pers:Do1 rel:husband pers:St1 . \n"++var41 :: [[RDFVarBinding]]+var41 = rdfQueryBack query41 graph41++res41 :: [[(RDFGraph, [RDFLabel])]]+res41 = rdfQueryBackSubs var41 result41++graph42 :: RDFGraph+graph42 = graphFromString $ prefix4 +++    "pers:Pa2 rel:grandparent pers:Ro4 . \n"++query42 :: RDFGraph+query42 = graphFromString $ prefix4 +++    "?a rel:grandparent ?c . \n"++result42 :: RDFGraph+result42 = graphFromString $ prefix4 +++    "?a rel:son ?b . \n" +++    "?b rel:son ?c . \n"++result42a :: String+result42a = prefix4 +++    "pers:Pa2 rel:son ?b       . \n" +++    "?b       rel:son pers:Ro4 . \n"++var42 :: [[RDFVarBinding]]+var42 = rdfQueryBack query42 graph42++res42 :: [[(RDFGraph, [RDFLabel])]]+res42 = rdfQueryBackSubs var42 result42++graph43 :: RDFGraph+graph43 = graphFromString $ prefix4 +++    "pers:Gr3 rel:brother pers:La3 . \n"++query43 :: RDFGraph+query43 = graphFromString $ prefix4 +++    "?b rel:brother ?c . \n"++result43 :: RDFGraph+result43 = graphFromString $ prefix4 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result43a :: String+result43a = prefix4 +++    "?a rel:son pers:Gr3 . \n" +++    "?a rel:son pers:La3 . \n"++var43 :: [[RDFVarBinding]]+var43 = rdfQueryBack query43 graph43++res43 :: [[(RDFGraph, [RDFLabel])]]+res43 = rdfQueryBackSubs var43 result43++graph44 :: RDFGraph+graph44 = graphFromString $ prefix4 +++    "pers:Pa2 rel:grandson pers:Ro4 . \n"++query44 :: RDFGraph+query44 = graphFromString $ prefix4 +++    "?a rel:grandson ?b . \n" +++    "?c rel:grandson ?d . \n"++result44 :: RDFGraph+result44 = graphFromString $ prefix4 +++    "?a rel:son      ?m . \n" +++    "?m rel:son      ?b . \n" +++    "?c rel:daughter ?n . \n" +++    "?n rel:son      ?d . \n"++result44a, result44b :: String+result44a = prefix4 +++    "pers:Pa2 rel:son ?m       . \n" +++    "?m       rel:son pers:Ro4 . \n" +++    "?c rel:daughter ?n . \n" +++    "?n rel:son      ?d . \n"++result44b = prefix4 +++    "?a rel:son      ?m . \n" +++    "?m rel:son      ?b . \n" +++    "pers:Pa2 rel:daughter ?n .       \n" +++    "?n       rel:son      pers:Ro4 . \n"++unbound44a, unbound44b :: [RDFLabel]+unbound44a = [(Var "m"),(Var "c"),(Var "n"),(Var "d")]+unbound44b = [(Var "a"),(Var "m"),(Var "b"),(Var "n")]++var44 :: [[RDFVarBinding]]+var44 = rdfQueryBack query44 graph44++res44 :: [[(RDFGraph, [RDFLabel])]]+res44 = rdfQueryBackSubs var44 result44++res44_1, res44_2 :: [(RDFGraph, [RDFLabel])]+[res44_1,res44_2] = res44++--  test45:  multiple substitutions used together+--+--  (?a daughter ?b, ?a son ?c) => ?b brother ?c+--+--  (b1 brother c1, b2 brother c2) if+--      (?a daughter b1, ?a son c1) && (?a daughter b2, ?a son c2)++graph45 :: RDFGraph+graph45 = graphFromString $ prefix4 +++    "pers:Rh4 rel:brother pers:Ro4 . \n" +++    "pers:Ma3 rel:brother pers:Wi3 . \n"++query45 :: RDFGraph+query45 = graphFromString $ prefix4 +++    "?b rel:brother ?c . \n"++result45 :: RDFGraph+result45 = graphFromString $ prefix4 +++    "?a rel:daughter ?b . \n" +++    "?a rel:son      ?c . \n"++result45a1, result45a2 :: String+result45a1 = prefix4 +++    "?a rel:daughter pers:Rh4 . \n" +++    "?a rel:son      pers:Ro4 . \n"++result45a2 = prefix4 +++    "?a rel:daughter pers:Ma3 . \n" +++    "?a rel:son      pers:Wi3 . \n"++unbound45a1, unbound45a2 :: [RDFLabel]+unbound45a1 = [(Var "a")]+unbound45a2 = [(Var "a")]++var45 :: [[RDFVarBinding]]+var45 = rdfQueryBack query45 graph45++res45 :: [[(RDFGraph, [RDFLabel])]]+res45 = rdfQueryBackSubs var45 result45++res45_1 :: [(RDFGraph, [RDFLabel])]+[res45_1] = res45++res45_11, res45_12 :: (RDFGraph, [RDFLabel])+[res45_11,res45_12] = res45_1++--  test46:  multiple ways to get solution+--+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)+--+--  a stepBrother b if+--      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)++graph46 :: RDFGraph+graph46 = graphFromString $ prefix4 +++    "pers:Gr3 rel:stepbrother pers:St3 . \n"++query46 :: RDFGraph+query46 = graphFromString $ prefix4 +++    "?b rel:stepbrother ?c . \n" +++    "?c rel:stepbrother ?b . \n"++result46 :: RDFGraph+result46 = graphFromString $ prefix4 +++    "?a rel:son     ?b . \n" +++    "?a rel:stepson ?c . \n"++result46a, result46b :: String+result46a = prefix4 +++    "?a rel:son     pers:St3 . \n" +++    "?a rel:stepson pers:Gr3 . \n"+result46b = prefix4 +++    "?a rel:son     pers:Gr3 . \n" +++    "?a rel:stepson pers:St3 . \n"++unbound46a, unbound46b :: [RDFLabel]+unbound46a = [(Var "a")]+unbound46b = [(Var "a")]++var46 :: [[RDFVarBinding]]+var46 = rdfQueryBack query46 graph46++res46 :: [[(RDFGraph, [RDFLabel])]]+res46 = rdfQueryBackSubs var46 result46++res46_1, res46_2 :: [(RDFGraph, [RDFLabel])]+[res46_1,res46_2] = res46++res46_11, res46_21 :: (RDFGraph, [RDFLabel])+[res46_11] = res46_1+[res46_21] = res46_2++--  test47:  multiple ways to multiple solutions+--+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)+--+--  (a stepBrother b, c stepBrother d) if+--      ((_:e son a, _:e stepSon b) && (_:f son a, _:f stepSon b)) ||+--      ((_:e son a, _:e stepSon b) && (_:f stepSon a, _:f son b)) ||+--      ((_:e stepSon a, _:e son b) && (_:f son a, _:f stepSon b)) ||+--      ((_:e stepSon a, _:e son b) && (_:f stepSon a, _:f son b))++graph47 :: RDFGraph+graph47 = graphFromString $ prefix4 +++    "pers:Gr3 rel:stepbrother pers:St3 . \n" +++    "pers:St3 rel:stepbrother pers:Gr3 . \n"++query47 :: RDFGraph+query47 = graphFromString $ prefix4 +++    "?b rel:stepbrother ?c . \n" +++    "?c rel:stepbrother ?b . \n"++result47 :: RDFGraph+result47 = graphFromString $ prefix4 +++    "?a rel:son     ?b . \n" +++    "?a rel:stepson ?c . \n"++result47a1, result47a2,+  result47b1, result47b2,+  result47c1, result47c2,+  result47d1, result47d2 :: String++result47a1 = prefix4 +++    "?a rel:son     pers:St3 . \n" +++    "?a rel:stepson pers:Gr3 . \n"++result47a2 = prefix4 +++    "?a rel:son     pers:Gr3 . \n" +++    "?a rel:stepson pers:St3 . \n"++result47b1 = prefix4 +++    "?a rel:stepson pers:St3 . \n" +++    "?a rel:son     pers:Gr3 . \n"++result47b2 = prefix4 +++    "?a rel:stepson pers:St3 . \n" +++    "?a rel:son     pers:Gr3 . \n"++result47c1 = prefix4 +++    "?a rel:son     pers:St3 . \n" +++    "?a rel:stepson pers:Gr3 . \n"++result47c2 = prefix4 +++    "?a rel:son     pers:St3 . \n" +++    "?a rel:stepson pers:Gr3 . \n"++result47d1 = prefix4 +++    "?a rel:stepson pers:St3 . \n" +++    "?a rel:son     pers:Gr3 . \n"++result47d2 = prefix4 +++    "?a rel:son     pers:St3 . \n" +++    "?a rel:stepson pers:Gr3 . \n"++unbound47a1, unbound47a2,+  unbound47b1, unbound47b2,+  unbound47c1, unbound47c2,+  unbound47d1, unbound47d2 :: [RDFLabel]++unbound47a1 = [(Var "a")]+unbound47a2 = [(Var "a")]+unbound47b1 = [(Var "a")]+unbound47b2 = [(Var "a")]+unbound47c1 = [(Var "a")]+unbound47c2 = [(Var "a")]+unbound47d1 = [(Var "a")]+unbound47d2 = [(Var "a")]++var47 :: [[RDFVarBinding]]+var47 = rdfQueryBack query47 graph47++res47 :: [[(RDFGraph, [RDFLabel])]]+res47 = rdfQueryBackSubs var47 result47++res47_1, res47_2, res47_3, res47_4 :: [(RDFGraph, [RDFLabel])]+[res47_1,res47_2,res47_3,res47_4] = res47++res47_11, res47_12,+  res47_21, res47_22, +  res47_31, res47_32, +  res47_41, res47_42 :: (RDFGraph, [RDFLabel])+[res47_11,res47_12] = res47_1+[res47_21,res47_22] = res47_2+[res47_31,res47_32] = res47_3+[res47_41,res47_42] = res47_4++--  test48:  redundant multiple ways to get solution+--+--  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)+--+--  (a brother b) if+--      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)++graph48 :: RDFGraph+graph48    = graphFromString $ prefix4 +++    "pers:Gr3 rel:brother pers:La3 . \n"++query48 :: RDFGraph+query48    = graphFromString $ prefix4 +++    "?b rel:brother ?c . \n" +++    "?c rel:brother ?b . \n"++result48 :: RDFGraph+result48    = graphFromString $ prefix4 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result48a, result48b :: String+result48a = prefix4 +++    "?a rel:son pers:La3 . \n" +++    "?a rel:son pers:Gr3 . \n"+result48b = prefix4 +++    "?a rel:son pers:Gr3 . \n" +++    "?a rel:son pers:La3 . \n"+    +unbound48a, unbound48b :: [RDFLabel]+unbound48a = [(Var "a")]+unbound48b = [(Var "a")]++var48 :: [[RDFVarBinding]]+var48 = rdfQueryBack query48 graph48++res48 :: [[(RDFGraph, [RDFLabel])]]+res48 = rdfQueryBackSubs var48 result48++res48_1, res48_2 :: [(RDFGraph, [RDFLabel])]+[res48_1,res48_2] = res48++res48_11, res48_21 :: (RDFGraph, [RDFLabel])+[res48_11] = res48_1+[res48_21] = res48_2++-- test49: goal not satisfiable by rule+--+--  (?a foo ?b, ?b foo ?a) => (?a bar ?a)+--+--  (a bar b) cannot be deduced directly++graph49 :: RDFGraph+graph49 = graphFromString $ prefix4 +++    "pers:Gr3 rel:foo pers:La3 . \n"++query49 :: RDFGraph+query49 = graphFromString $ prefix4 +++    "?a rel:bar ?a . \n"++result49 :: RDFGraph+result49 = graphFromString $ prefix4 +++    "?a rel:foo ?b . \n" +++    "?b rel:foo ?a . \n"++var49 :: [[RDFVarBinding]]+var49 = rdfQueryBack query49 graph49++res49 :: [[(RDFGraph, [RDFLabel])]]+res49 = rdfQueryBackSubs var49 result49++--  test50:  back-chaining with filter+--+--  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)+--+--  (a brother b) if+--      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)++graph50 :: RDFGraph+graph50 = graphFromString $ prefix4 +++    "pers:Gr3 rel:brother pers:Gr3 . \n"++query50 :: RDFGraph+query50 = graphFromString $ prefix4 +++    "?b rel:brother ?c . \n" +++    "?c rel:brother ?b . \n"++result50 :: RDFGraph+result50 = graphFromString $ prefix4 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result50a, result50b :: String+result50a = prefix4 +++    "?a rel:son pers:Gr3 . \n" +++    "?a rel:son pers:Gr3 . \n"++result50b = prefix4 +++    "?a rel:son pers:Gr3 . \n" +++    "?a rel:son pers:Gr3 . \n"++unbound50a, unbound50b :: [RDFLabel]+unbound50a = [(Var "a")]+unbound50b = [(Var "a")]++var50 :: [[RDFVarBinding]]+var50 = rdfQueryBack query50 graph50++res50 :: [[(RDFGraph, [RDFLabel])]]+res50 = rdfQueryBackSubs var50 result50++res50_1, res50_2 :: [(RDFGraph, [RDFLabel])]+[res50_1,res50_2] = res50++res50_11, res50_21 :: (RDFGraph, [RDFLabel])+[res50_11] = res50_1+[res50_21] = res50_2++filter50 :: RDFVarBindingFilter+filter50 = varFilterNE (Var "b") (Var "c")++var50F :: [[RDFVarBinding]]+var50F = rdfQueryBackFilter filter50 var50++res50F :: [[(RDFGraph, [RDFLabel])]]+res50F = rdfQueryBackSubs var50F result50++--  Backward substitution query test suite++test4 :: Test+test4 = +  TestList+  [ test "testQuery41" (not $ null var41)+  , testEq "testQuery41a" 1 (length var41)+  , testEq "testResult41" 1 (length res41)+  , testGr "testResult41a" result41a (fst $ unzip $ head res41)+  , testLs "testUnbound41a" [] (snd $ head $ head res41)+  , test "testQuery42" (not $ null var42)+  , testEq "testQuery42a" 1 (length var42)+  , testEq "testResult42" 1 (length res42)+  , testGr "testResult42a" result42a (fst $ unzip $ head res42)+  , testLs "testUnbound42a" [(Var "b")] (snd $ head $ head res42)+  , test "testQuery43" (not $ null var43)+  , testEq "testQuery43a" 1 (length var43)+  , testEq "testResult43" 1 (length res43)+  , testGr "testResult43a" result43a (fst $ unzip $ head res43)+  , testLs "testUnbound43a" [(Var "a")] (snd $ head $ head res43)+  , test "testQuery44" (not $ null var44)+  , testEq "testQuery44a"   2 (length var44)+  , testEq "testResult44"   2 (length res44)+  , testGr "testResult44a"  result44a  (fst $ unzip res44_2)+  , testLs "testUnbound44a" unbound44a (snd $ head res44_2)+  , testGr "testResult44b"  result44b  (fst $ unzip res44_1)+  , testLs "testUnbound44b" unbound44b (snd $ head res44_1)+  , test "testQuery45" (not $ null var45)+  , testEq "testQuery45a"   1 (length var45)+  , testEq "testResult45"   1 (length res45)+  , testEq "testResult45_1" 2 (length res45_1)+  , testGr "testResult45a1"  result45a1  [fst res45_11]+  , testLs "testUnbound45a1" unbound45a1 (snd res45_11)+  , testGr "testResult45a2"  result45a2  [fst res45_12]+  , testLs "testUnbound45a2" unbound45a2 (snd res45_12)+  , test "testQuery46" (not $ null var46)+  , testEq "testQuery46a"   2 (length var46)+  , testEq "testResult46"   2 (length res46)+  , testEq "testResult46_1" 1 (length res46_1)+  , testEq "testResult46_2" 1 (length res46_2)+  , testGr "testResult46a"  result46a  [fst res46_11]+  , testLs "testUnbound46a" unbound46a (snd res46_11)+  , testGr "testResult46b"  result46b  [fst res46_21]+  , testLs "testUnbound46b" unbound46b (snd res46_21)+  , test "testQuery47" (not $ null var47)+  , testEq "testQuery47a"   4 (length var47)+  , testEq "testResult47"   4 (length res47)+  , testEq "testResult47_1" 2 (length res47_1)+  , testEq "testResult47_2" 2 (length res47_2)+  , testEq "testResult47_3" 2 (length res47_3)+  , testEq "testResult47_4" 2 (length res47_4)+  , testGr "testResult47a1"  result47a1  [fst res47_11]+  , testLs "testUnbound47a1" unbound47a1 (snd res47_11)+  , testGr "testResult47a2"  result47a2  [fst res47_12]+  , testLs "testUnbound47a2" unbound47a2 (snd res47_12)+  , testGr "testResult47b1"  result47b1  [fst res47_21]+  , testLs "testUnbound47b1" unbound47b1 (snd res47_21)+  , testGr "testResult47b2"  result47b2  [fst res47_22]+  , testLs "testUnbound47b2" unbound47b2 (snd res47_22)+  , testGr "testResult47c1"  result47c1  [fst res47_31]+  , testLs "testUnbound47c1" unbound47c1 (snd res47_31)+  , testGr "testResult47c2"  result47c2  [fst res47_32]+  , testLs "testUnbound47c2" unbound47c2 (snd res47_32)+  , testGr "testResult47d1"  result47d1  [fst res47_41]+  , testLs "testUnbound47d1" unbound47d1 (snd res47_41)+  , testGr "testResult47d2"  result47d2  [fst res47_42]+  , testLs "testUnbound47d2" unbound47d2 (snd res47_42)+  , test "testQuery48" (not $ null var48)+  , testEq "testQuery48a"   2 (length var48)+  , testEq "testResult48"   2 (length res48)+  , testEq "testResult48_1" 1 (length res48_1)+  , testEq "testResult48_2" 1 (length res48_2)+  , testGr "testResult48a"  result48a  [fst res48_11]+  , testLs "testUnbound48a" unbound48a (snd res48_11)+  , testGr "testResult48b"  result48b  [fst res48_21]+  , testLs "testUnbound48b" unbound48b (snd res48_21)+  , test "testQuery49" (null var49)+  , testEq "testQuery49a"   0 (length var49)+  , testEq "testResult49"   0 (length res49)+  , test "testQuery50" (not $ null var50)+  , testEq "testQuery50a"   2 (length var50)+  , testEq "testResult50"   2 (length res50)+  , testEq "testResult50_1" 1 (length res50_1)+  , testEq "testResult50_2" 1 (length res50_2)+  , testGr "testResult50a"  result50a  [fst res50_11]+  , testLs "testUnbound50a" unbound50a (snd res50_11)+  , testGr "testResult50b"  result50b  [fst res50_21]+  , testLs "testUnbound50b" unbound50b (snd res50_21)+  , testEq "testResult50F" 0 (length res50F)+  ]++------------------------------------------------------------+--  Instance query test suite+------------------------------------------------------------+--+--  The test plan is this:+--  (1) perform a backward chaining query against some desired result.+--      ?f father ?a, ?f father ?b, ?a /= ?b => ?a brother ?b+--      against+--      Gr3 brother La3, Gr3 brother Si3+--      should yield:+--      _:a father Gr3+--      _:a father La3+--      _:b father Gr3+--      _:b father Si3+--  (2) Perform instance query of result against 'graph2' (see above)+--      should yield:+--      _:a = Pa2+--      _:b = Pa2+--  (3) Substitute this into query, should yield:+--      Pa2 father Gr3+--      Pa2 father La3+--      Pa2 father Gr3+--      Pa2 father Si3+--  (4) Use this result in an instance query against 'graph2':  it should+--      match without any variable substitutions, indicating that it is+--      a subgraph++graph61 :: RDFGraph+graph61 = graphFromString $ prefix4 +++    "pers:Gr3 rel:brother pers:La3 . \n" +++    "pers:Gr3 rel:brother pers:Si3 . \n"++query61 :: RDFGraph+query61 = graphFromString $ prefix4 +++    "?b rel:brother ?c . \n"++result61 :: RDFGraph+result61 = graphFromString $ prefix4 +++    "?a rel:son ?b . \n" +++    "?a rel:son ?c . \n"++result61a, result63a :: String+result61a = prefix4 +++    "_:a1 rel:son pers:Gr3 . \n" +++    "_:a1 rel:son pers:La3 . \n" +++    "_:a2 rel:son pers:Gr3 . \n" +++    "_:a2 rel:son pers:Si3 . \n"++result63a = prefix4 +++    "pers:Pa2 rel:son pers:Gr3 . \n" +++    "pers:Pa2 rel:son pers:La3 . \n" +++    "pers:Pa2 rel:son pers:Gr3 . \n" +++    "pers:Pa2 rel:son pers:Si3 . \n"++--  1. Backchain query with blank substutions++var61 :: [[RDFVarBinding]]+var61          = rdfQueryBack query61 graph61++res61 :: [[RDFGraph]]+res61          = rdfQueryBackSubsBlank var61 result61++res61a1, res61a2, res61a :: RDFGraph+[[res61a1,res61a2]] = res61+res61a = merge res61a1 res61a2++--  2. Instance query against 'graph2'++var62 :: [RDFVarBinding]+var62 = rdfQueryInstance res61a graph2++--  3. Substitute into instance query graph++res63 :: [RDFGraph]+res63 = rdfQuerySubs var62 res61a++res63a :: RDFGraph+[res63a] = res63++--  4. Repeat instance query against 'graph2'+--     Query bindings should be null.++var64 :: [RDFVarBinding]+var64 = rdfQueryInstance res63a graph2++var64a :: RDFVarBinding+[var64a] = var64++test6 :: Test+test6 = +  TestList+  [ test   "testQuery61" (not $ null var61)+  , testEq "testQuery61a" 1 (length var61)+  , testEq "testResult61" 1 (length res61)+  , testGr "testResult61a" result61a [res61a]+  , test   "testQuery62" (not $ null var62)+  , testEq "testQuery62a" 1 (length var62)+  , test   "testQuery63" (not $ null res63)+  , testEq "testQuery63a" 1 (length res63)+  , testGr "testResult63a" result63a [res63a]+  , test   "testQuery64" (not $ null var64)+  , testEq "testQuery64a" 1 (length var64)+  , test   "testQuery64b" (null $ vbEnum var64a)+  ]    ++------------------------------------------------------------+--  Specific test cases+------------------------------------------------------------++--  Back-chaining query binding modifier++--  Set up call of rdfQueryBackModify+--  (1) simple filter+--  (2) allocate new binding+{-+rdfQueryBackModify ::+    RDFVarBindingModify -> [[RDFVarBinding]] -> [[RDFVarBinding]]+rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss+-}++baseex :: String+baseex = "http://example.org/"++baserdf :: String+baserdf  = nsURI namespaceRDF++q_dattyp :: ScopedName+q_dattyp = makeScopedName "" baseex "datatype"++v_a, v_b, v_c, v_x, v_y, v_z :: RDFLabel+v_a   = Var "a"+v_b   = Var "b"+v_c   = Var "c"+v_x   = Var "x"+v_y   = Var "y"+v_z   = Var "z"++u_s, u_o, u_p, u_p1, u_p2a, u_p2b, u_m1, u_m2,+  u_rt, u_xt, u_dt :: RDFLabel+u_s   = Res $ makeScopedName "" baseex "s"+u_o   = Res $ makeScopedName "" baseex "o"+u_p   = Res $ makeScopedName "" baseex "p"+u_p1  = Res $ makeScopedName "" baseex "p1"+u_p2a = Res $ makeScopedName "" baseex "p2a"+u_p2b = Res $ makeScopedName "" baseex "p2b"+u_m1  = Res $ makeScopedName "" baserdf "_1"+u_m2  = Res $ makeScopedName "" baserdf "_2"+u_rt  = Res rdf_type+u_xt  = Res rdf_XMLLiteral+u_dt  = Res q_dattyp++l_1, l_2, l_3, l_4, l_5 :: RDFLabel+l_1   = Lit "l1" Nothing+l_2   = Lit "l2" (Just $ langName "fr")+l_3   = Lit "l3" (Just q_dattyp)+l_4   = Lit "l4" (Just q_dattyp) -- was: (Lang "fr")+l_5   = Lit "l5" (Just rdf_XMLLiteral)++b_1, b_2, b_3, b_l1, b_l2 :: RDFLabel+b_1   = Blank "1"+b_2   = Blank "2"+b_3   = Blank "3"+b_l1  = Blank "l1"+b_l2  = Blank "l2"++vbss01a, vbss01b, vbss01c, vbss01d, vbss01e, vbss01f,+  vbss01g, vbss01h, vbss01i :: [RDFVarBinding]+vbss01a =               -- ?a is uri, ?b is uri+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,u_o) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]+    ]++vbss01b =               -- ?c is blank+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]+    ]++vbss01c =               -- ?c is literal+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]+    ]++vbss01d =               -- ?c is untyped literal+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]+    ]++vbss01e =               -- ?c is typed literal+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_4) ]+    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5) ]+    ]++vbss01f =               -- ?c is XML literal+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_5) ]+    ]++vbss01g =               -- ?b is member property+    [ makeVarBinding [ (v_a,b_1), (v_b,u_m1), (v_c,u_o) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_m2), (v_c,b_1) ]+    ]++vbss01h =               -- ?c is datatyped with ?x+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]+    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_dt) ]+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]+    ]++vbss01i =               -- ?c is not datatyped with ?x+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]+    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_xt) ]+    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]+    ]++vbss01 :: [[RDFVarBinding]]+vbss01  = [ vbss01a     -- ?a is uri, ?b is uri+          , vbss01b     -- ?c is blank+          , vbss01c     -- ?c is literal+          , vbss01d     -- ?c is untyped literal+          , vbss01e     -- ?c is typed literal+          , vbss01f     -- ?c is XML literal+          , vbss01g     -- ?b is member property+          , vbss01h     -- ?c is datatyped with ?x+          , vbss01i     -- ?c is not datatyped with ?x+          ]++vbss02a, vbss02b, vbss02c, vbss02d :: [RDFVarBinding]++vbss02a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]+          , makeVarBinding [ (v_b,b_l1) ]+          , makeVarBinding [ (v_b,b_l2) ]+          ]++vbss02b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]+          , makeVarBinding [ (v_b,b_l2) ]+          ]++vbss02c = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+          , makeVarBinding [ (v_b,b_l1) ]+          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]+          ]++vbss02d = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]+          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]+          ]++vbss02 :: [[RDFVarBinding]]+vbss02  = [ vbss02a+          , vbss02b+          , vbss02c+          , vbss02d+          ]++--  Variable binding modifier that adds new bindings, if certain+--  others are present.++vbm22 :: VarBindingModify RDFLabel RDFLabel+vbm22 = VarBindingModify+        { vbmName  = swishName "vbm22"+        , vbmApply = concatMap apply1+        , vbmVocab = [v_a,v_b,v_x,v_y]+        , vbmUsage = [[v_y]]+        }+    where+        apply1 :: RDFVarBinding -> [RDFVarBinding]+        apply1 vb = apply2 vb (vbMap vb v_a) (vbMap vb v_b) (vbMap vb v_x)+        apply2 vb (Just a) (Just b) (Just _) =+            [ joinVarBindings nva vb, joinVarBindings nvb vb ]+            where+                nva = makeVarBinding [(v_y,a)]+                nvb = makeVarBinding [(v_y,b)]+        apply2 _ _ _ _ = []++vbss02dy :: [[RDFVarBinding]]+vbss02dy = sequence+    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]+      ]+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]+      ]+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,u_p2b) ]+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,b_l2)  ]+      ]+    , [ makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]+      , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]+      ]+    , [ makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]+      , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]+      ]+    ]++--  simplified version of above for debugging --++vbss03a :: [RDFVarBinding]+vbss03a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_b,b_l1) ]+          ]++vbss03b :: [RDFVarBinding]+vbss03b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+          ]++vbss03 :: [[RDFVarBinding]]+vbss03  = [ vbss03a+          , vbss03b+          ]++vbss03by :: [[RDFVarBinding]]+vbss03by = sequence+    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]+      ]+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]+      ]+    ]++test7 :: Test+test7 = TestList+    [ testEq "testBackMod01" vbss01 $+                rdfQueryBackModify varBindingId vbss01+    , testEq "testBackMod02" [vbss01a,vbss01b,vbss01c,vbss01d] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)+                    vbss01+    , testEq "testBackMod03" [vbss01f,vbss01i] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingBlank v_a)+                    vbss01+    , testEq "testBackMod04" vbss01 $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingUriRef v_b)+                    vbss01+    , testEq "testBackMod05"+                [vbss01c,vbss01d,vbss01e,vbss01f,vbss01h,vbss01i] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingLiteral v_c)+                    vbss01+    , testEq "testBackMod06" [vbss01d] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingUntypedLiteral v_c)+                    vbss01+    , testEq "testBackMod07" [vbss01e,vbss01f,vbss01h,vbss01i] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingTypedLiteral v_c)+                    vbss01+    , testEq "testBackMod08" [vbss01f] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingXMLLiteral v_c)+                    vbss01+    , testEq "testBackMod09" [vbss01g] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingMemberProp v_b)+                    vbss01+    , testEq "testBackMod10" [vbss01h] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingDatatyped v_x v_c)+                    vbss01+    , testEq "testBackMod20" vbss02 $+                rdfQueryBackModify varBindingId vbss02+    , testEq "testBackMod21" [vbss02d] $+                rdfQueryBackModify+                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)+                    vbss02+    , testEq "testBackMod22" vbss02dy $+                rdfQueryBackModify vbm22 vbss02+    , testEq "testBackMod30" vbss03by $+                rdfQueryBackModify vbm22 vbss03+    ]++------------------------------------------------------------+--  Test simple value and list queries+------------------------------------------------------------++{-+TODO: for now remove this from the test since it uses :-++namespacetest, namespacelist :: Namespace+namespacetest    =+    Namespace   "test"   "urn:test:"+namespacelist    =+    Namespace   "list"   "urn:list:"++qntest, qnlist :: String -> ScopedName+qntest loc = ScopedName namespacetest loc+qnlist loc = ScopedName namespacelist loc++prefixlist :: String+prefixlist =+    "@prefix rdf  : <" ++ nsURI namespaceRDF ++ "> . \n"  +++    "@prefix xsd  : <" ++ nsURI namespaceXSD ++ "> . \n"  +++    "@prefix test : <" ++ nsURI namespacetest ++ "> . \n" +++    "@prefix list : <" ++ nsURI namespacelist ++ "> . \n" +++    " \n"++graphlist    = graphFromString graphliststr+graphliststr = prefixlist +++    "test:a rdf:type test:C1 ; "                   +++    "  test:p test:item1 ; "                       +++    "  test:p test:item2 . "                       +++    "test:b rdf:type test:C1 ; "                   +++    "  test:p \"1\"^^xsd:integer ; "               +++    "  test:p \"2\"^^xsd:integer ; "               +++    "  test:p \"3\"^^xsd:integer . "               +++    "test:c rdf:type test:C1 ; "                   +++    "  test:q \"1\"^^xsd:integer ; "               +++    "  test:q \"2\"^^xsd:boolean ; "               +++    "  test:q \"3\" . "                            +++    "list:three :- (list:_1 list:_2 list:_3) . \n" +++    "list:empty :- () . \n"++testC1  = Res (qntest "C1")+testabc = [ Res (qntest "a"),Res (qntest "b"),Res (qntest "c") ]+testp   = Res (qntest "p")+testq   = Res (qntest "q")+testi12 = [ Res (qntest "item1"),Res (qntest "item2") ]+test123 = [ Lit "1" (Just xsd_integer)+          , Lit "2" (Just xsd_integer)+          , Lit "3" (Just xsd_integer)+          ]+test1fp = [ Lit "1" (Just xsd_integer)+          , Lit "2" (Just xsd_boolean)+          , Lit "3" Nothing+          ]++list01 = [Res (qnlist "_1"),Res (qnlist "_2"),Res (qnlist "_3")]+list02 = []++testVal01  = testEqv "testVal01" testabc $+                rdfFindValSubj res_rdf_type testC1 graphlist+testVal02  = testEqv "testVal02" testi12 $+                rdfFindPredVal (testabc!!0) testp graphlist+testVal03  = testEqv "testVal03" test123 $+                rdfFindPredVal (testabc!!1) testp graphlist+testVal04  = testEqv "testVal04" test1fp $+                rdfFindPredVal (testabc!!2) testq graphlist+testVal05  = testEqv "testVal05" [] $+                rdfFindPredVal (testabc!!2) testp graphlist+testVal06  = testEqv "testVal06" [] $+                rdfFindPredInt (testabc!!0) testp graphlist+testVal07  = testEqv "testVal07" [1,2,3] $+                rdfFindPredInt (testabc!!1) testp graphlist+testVal08  = testEqv "testVal08" [1] $+                rdfFindPredInt (testabc!!2) testq graphlist++testlist01 = testEq "testlist01" list01 $+    rdfFindList graphlist (Res $ qnlist "three")+testlist02 = testEq "testlist02" list02 $+    rdfFindList graphlist (Res $ qnlist "empty")++test8 = TestList+    [ testVal01, testVal02, testVal03, testVal04+    , testVal05, testVal06, testVal07, testVal08+    , testlist01, testlist02+    ]++-}++{-----+queryList :: RDFGraph -> RDFLabel -> [RDFLabel]+-- queryList gr res_rdf_nil = []+-- queryList gr hd          = findhead g:rdfQueryList gr (findrest g)+queryList gr hd+    | hd == res_rdf_nil = []+    | otherwise         = (findhead g):(queryList gr (findrest g))+    where+        g = subgr gr hd++findhead g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_first ]+findrest g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_rest  ]+subgr g h  = filter ((==) h . arcSubj) $ getArcs g+headOrNil  = foldr const res_rdf_nil++th1  = (Res $ qnlist "empty")+th3  = (Res $ qnlist "three")+th3a = subgr graphlist th3+th3b = findhead th3a+th3c = findrest th3a+tl3c = queryList graphlist th3c+th3d = subgr graphlist th3c+th3e = findhead th3d+th3f = findrest th3d++tl3  = queryList graphlist th3+-----}++------------------------------------------------------------+--  Full test suite, main program,+--  and useful expressions for interactive use+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ test1+  , test2+  , test3+  , test4+  , test6+  , test7+--  , test8+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT++shres32 = TestCase $ assertString (show res32)+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/RDFRulesetTest.hs view
@@ -0,0 +1,409 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  RDFRulesetTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for ruleset data.+--+--  Note that the proof-related methods defined in RDFRuleset are tested+--  by RDFProofTest and/or RDFProofCheck.+--+{--------+---------+---------+---------+---------+---------+---------+---------}++module Main where++import Swish.RDF.RDFRuleset+    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset+    , GraphClosure(..)+    , makeRDFGraphFromN3String+    , makeRDFFormula+    , makeN3ClosureSimpleRule+    , makeNodeAllocTo+    -- for debugging+    , graphClosureFwdApply, graphClosureBwdApply+    )++import Swish.RDF.RDFQuery+    ( rdfQueryBack, rdfQueryBackModify )++import Swish.RDF.RDFVarBinding+    ( RDFVarBinding+    , RDFVarBindingModify+    , RDFVarBindingFilter+    , rdfVarBindingXMLLiteral+    )++import Swish.RDF.RDFGraph+    ( Label (..), RDFLabel(..), RDFGraph+    , Arc(..)+    , getArcs+    , allLabels+    , toRDFGraph+    )+    +import Swish.RDF.VarBinding+    ( makeVarBinding+    , vbmCompose+    , makeVarFilterModify+    )++import Swish.RDF.Ruleset+    ( makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules+    , getRulesetAxiom, getRulesetRule )++import Swish.RDF.Rule+    ( Formula(..), Rule(..)+    , fwdCheckInference )++import Swish.Utils.Namespace+    ( Namespace(..)+    , ScopedName(..)+    , makeScopedName+    )++import Swish.RDF.Vocabulary+    ( namespaceRDF+    , namespaceOWL+    , scopeRDF+    )++import Test.HUnit+    ( Test(TestCase,TestList)+    , assertBool, assertEqual+    , runTestTT+    )++import Data.List (nub, sort)+import Data.Maybe (isJust, fromJust)++------------------------------------------------------------+--  Test case helpers+------------------------------------------------------------++test :: String -> Bool -> Test+test lab bv =+    TestCase ( assertBool ("test:"++lab) bv )++testVal :: (Eq a, Show a) => String -> a -> a -> Test+testVal lab a1 a2 =+    TestCase ( assertEqual ("testVal:"++lab) a1 a2 )++testEq :: (Eq a, Show a) => String -> Bool -> a -> a -> Test+testEq lab eq a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) eq (a1==a2) )++testEqual :: (Eq a, Show a) => String -> a -> a -> Test+testEqual lab a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test+testLe lab eq a1 a2 =+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )++testStringEq :: String -> String -> String -> Test+testStringEq lab s1 s2 =+    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )++testSameNamespace :: String -> Namespace -> Namespace -> Test+testSameNamespace lab n1 n2 =+    TestCase ( assertBool ("testSameNamespace:"++lab) ((p1==p2)&&(u1==u2)) )+    where+        p1 = nsPrefix n1+        p2 = nsPrefix n2+        u1 = nsURI n1+        u2 = nsURI n2++testScopedNameEq :: String -> Bool -> ScopedName -> ScopedName -> Test+testScopedNameEq lab eq n1 n2 =+    TestCase ( assertEqual ("testScopedNameEq:"++lab) eq (n1==n2) )++{-+testQNameEq :: String -> Bool -> QName -> QName -> Test+testQNameEq lab eq n1 n2 =+    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )+-}++testSameAxioms :: String -> [RDFFormula] -> [RDFFormula] -> Test+testSameAxioms lab as1 as2 =+    TestCase ( assertBool ("testSameAxioms:"++lab) sameas )+    where+        sameas = (sort as1) == (sort as2)++testSameRules :: String -> [RDFRule] -> [RDFRule] -> Test+testSameRules lab rs1 rs2 =+    TestCase ( assertBool ("testSameRules:"++lab) samers )+    where+        samers = (sort rs1) == (sort rs2)++------------------------------------------------------------+--  Common values+------------------------------------------------------------++pref_rdf, pref_owl :: String+pref_rdf = nsURI namespaceRDF+pref_owl = nsURI namespaceOWL++------------------------------------------------------------+--  Define and manipulate rulesets+------------------------------------------------------------+--+--  A ruleset is essentially a collection of axioms and rules+--  associated with a namespace.+--+--  Rulesets for RDF, RDFS and basic datatyping are predefined:+--  see RDFRuleset, RDFSRuleset and RDFDRuleset.+--  Additional rulesets may be defined for specific datatypes.+--+--  A proof context is a list of rulesets,+--  which may be cited by a proof.++rn1 :: Namespace+rn1  = Namespace "r1" "http://id.ninebynine.org/wip/2003/rulesettest/r1"++-- Common prefix declarations for graph expressions+pref :: String+pref =+    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" +++    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" +++    "@prefix ex:   <http://example.org/> . \n" +++    " \n"++a11, a12 :: RDFFormula+a11  = makeRDFFormula rn1 "a11" (pref++"ex:R1 rdf:type ex:C1 .")+a12  = makeRDFFormula rn1 "a12" (pref++"ex:R2 rdf:type ex:C2 .")++r11, r12 :: RDFRule+r11  = makeN3ClosureSimpleRule rn1 "r11"+            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )+            ( pref++"?r1 ex:P1 ?r2 ." )++r12  = makeN3ClosureSimpleRule rn1 "r12"+            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )+            ( pref++"?r2 ex:P2 ?r1 ." )++--  Basic formula and rule comparison tests+--  (tests support code added in module Proof.hs)++testFormulaSuite :: Test+testFormulaSuite =+  TestList+  [ testEq "testCmpAX01" True  a11 a11+  , testEq "testCmpAX02" False a11 a12+  , testLe "testCmpAX03" True  a11 a11+  , testLe "testCmpAX04" True  a11 a12+  , testLe "testCmpAX05" False a12 a11+  ]++testRuleSuite :: Test+testRuleSuite =+  TestList+  [ testEq "testCmpRU01" True  r11 r11+  , testEq "testCmpRU02" False r11 r12+  , testLe "testCmpRU03" True  r11 r11+  , testLe "testCmpRU04" True  r11 r12+  , testLe "testCmpRU05" False r12 r11+  ]++--  Test simple ruleset construction and access++a1s :: [RDFFormula]+a1s  = [ a11, a12 ]++r1s :: [RDFRule]+r1s  = [ r11, r12 ]++r1 :: RDFRuleset+r1 = makeRuleset rn1 a1s r1s++testRulesetSuite :: Test+testRulesetSuite = +  TestList+  [ testSameNamespace "testNS01" rn1 (getRulesetNamespace r1)+  , testSameAxioms    "testAX01" a1s (getRulesetAxioms r1)+  , testSameRules     "testRU01" r1s (getRulesetRules r1)+  , testEqual "testGeta11" (Just a11) $+      getRulesetAxiom (ScopedName rn1 "a11") r1+  , testEqual "testGeta11" (Just a12) $+      getRulesetAxiom (ScopedName rn1 "a12") r1+  , testEqual "testGetr11" (Just r11) $+      getRulesetRule (ScopedName rn1 "r11") r1+  , testEqual "testGetr12" (Just r12) $+      getRulesetRule (ScopedName rn1 "r12") r1+  , testEqual "testGetnone" Nothing $+      getRulesetRule (ScopedName rn1 "none") r1+  ]++------------------------------------------------------------+--  Component tests for RDF proof context+------------------------------------------------------------++prefix :: String+prefix =+    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" +++    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" +++    "@prefix ex:   <http://example.org/> . \n" +++    " \n"++scopeex :: Namespace+scopeex = Namespace "ex" "http://id.ninebynine.org/wip/2003/RDFProofCheck#"++makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula scope local gr =+    makeRDFFormula scope local (prefix++gr)++allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify+allocateTo bv av = makeNodeAllocTo (Var bv) (Var av)++isXMLLit :: String -> RDFVarBindingFilter+isXMLLit = rdfVarBindingXMLLiteral . Var++queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]+queryBack qas = rdfQueryBack (toRDFGraph qas) ++-- Backward chaining rdf:r2++rdfr2ant, rdfr2con :: RDFGraph+rdfr2ant  = makeRDFGraphFromN3String "?x ?a ?l . "+rdfr2con  = makeRDFGraphFromN3String "?x ?a ?b . ?b rdf:type rdf:XMLLiteral ."++rdfr2modv :: RDFVarBindingModify+rdfr2modv = allocateTo "b" "l" $ allLabels labelIsVar rdfr2ant++rdfr2modc :: Maybe RDFVarBindingModify+rdfr2modc = vbmCompose (makeVarFilterModify $ isXMLLit "l") rdfr2modv++rdfr2grc :: RDFClosure +rdfr2grc = GraphClosure+            { nameGraphRule = ScopedName scopeRDF "r2"+            , ruleAnt       = getArcs rdfr2ant+            , ruleCon       = getArcs rdfr2con+            , ruleModify    = fromJust rdfr2modc+            }++rdfr2rul :: RDFRule+rdfr2rul = Rule+            { ruleName       = nameGraphRule rdfr2grc+            , fwdApply       = graphClosureFwdApply rdfr2grc+            , bwdApply       = graphClosureBwdApply rdfr2grc+            , checkInference = fwdCheckInference rdfr2rul+            }++con03 :: RDFGraph+con03 = formExpr $ makeFormula scopeex "con03" $+    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." +++    "_:l1 rdf:type rdf:XMLLiteral ." +++    "_:l2 rdf:type rdf:XMLLiteral ."++v_a, v_b, v_x :: RDFLabel+v_a   = Var "a"+v_b   = Var "b"+v_x   = Var "x"++u_s, u_p1, u_p2a, u_p2b, u_rt, u_rx :: RDFLabel+u_s   = Res $ makeScopedName "" "http://example.org/" "s"+u_p1  = Res $ makeScopedName "" "http://example.org/" "p1"+u_p2a = Res $ makeScopedName "" "http://example.org/" "p2a"+u_p2b = Res $ makeScopedName "" "http://example.org/" "p2b"+u_rt  = Res $ makeScopedName "" pref_rdf "type"+u_rx  = Res $ makeScopedName "" pref_rdf "XMLLiteral"++b_l1, b_l2 :: RDFLabel+b_l1  = Blank "l1"+b_l2  = Blank "l2"++rdfr2v1, rdfr2b1, rdfr2v2, rdfr2v3 :: [[RDFVarBinding]]+rdfr2v1 = queryBack (ruleCon rdfr2grc) con03++rdfr2b1 = [ [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]+            , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]+            , makeVarBinding [ (v_b,b_l1) ]+            , makeVarBinding [ (v_b,b_l2) ]+            ]+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]+            , makeVarBinding [ (v_b,b_l2) ]+            ]+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+            , makeVarBinding [ (v_b,b_l1) ]+            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]+            ]+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]+            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]+            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]+            ]+          ]++rdfr2v2 = rdfQueryBackModify (ruleModify rdfr2grc) rdfr2v1+rdfr2v3 = map nub rdfr2v2++testRDFSuite :: Test+testRDFSuite = +  TestList+  [ test    "testRDF01" $ isJust rdfr2modc+  , testVal "testRDF02" rdfr2b1 rdfr2v1+  , testVal "testRDF03" [] rdfr2v2+  , testVal "testRDF04" [] rdfr2v3+  , testEq "testRDF09" True [] $ bwdApply rdfr2rul con03+  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+  [ testFormulaSuite+  , testRuleSuite+  , testRulesetSuite+  , testRDFSuite+  ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------
+ tests/VarBindingTest.hs view
@@ -0,0 +1,899 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  VarBindingTest+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  This module contains test cases for variable binding values and+--  variable binding modifier values.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.VarBinding+    ( VarBinding(..)+    , subBinding, nullVarBinding, makeVarBinding+    , boundVars, subBinding, makeVarBinding+    , applyVarBinding, joinVarBindings+    , VarBindingModify(..)+    , vbmCompatibility, vbmCompose+    , findCompositions, findComposition+    , makeVarFilterModify+    , makeVarTestFilter+    , varBindingId, varFilterDisjunction, varFilterConjunction+    , varFilterEQ, varFilterNE+    )++import Swish.RDF.Vocabulary+    ( swishName )++import Swish.Utils.ListHelpers+    ( equiv )++import Test.HUnit+    ( Test(TestCase,TestList)+    , Assertion+    , assertBool, assertEqual, assertFailure+    , runTestTT+    )++import Control.Monad (unless)+import Data.List (union, intersect)+import Data.Maybe (isJust, fromJust)++------------------------------------------------------------+--  Test case helpers+------------------------------------------------------------++assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion+assertMember preface expected actual =+  unless (expected `elem` actual ) (assertFailure msg)+  where msg = (if null preface then "" else preface ++ "\n") +++             "expected: " ++ show expected ++ "\nbut got: " ++ show actual++test :: String -> Bool -> Test+test lab bv =+    TestCase ( assertBool ("test:"++lab) bv )++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 =+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test+testLe lab eq a1 a2 =+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )++-- Test for Just x or Nothing++testJust :: String -> Maybe a -> Test+testJust lab av =+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )++testNothing :: String -> Maybe a -> Test+testNothing lab av =+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )++-- Compare lists and lists of lists and Maybe lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+    show (ListTest a) = show a++data MaybeListTest a = MaybeListTest (Maybe [a])++instance (Eq a) => Eq (MaybeListTest a) where+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2+    MaybeListTest Nothing   == MaybeListTest Nothing   = True+    _                       == _                       = False++instance (Show a) => Show (MaybeListTest a) where+    show (MaybeListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test+testEqvEqv lab a1 a2 =+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest $ map ListTest a1+        ma2 = ListTest $ map ListTest a2++testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test+testHasEqv lab a1 a2 =+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )+    where+        ma1 = ListTest a1+        ma2 = map ListTest a2++testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test+testMaybeEqv lab a1 a2 =+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )+    where+        ma1 = (MaybeListTest a1)+        ma2 = (MaybeListTest a2)++------------------------------------------------------------+--  Define and variable bindings+------------------------------------------------------------++vb1 :: VarBinding Int String+vb1    = makeVarBinding [(1,"a"),(2,"b"),(3,"c")]++vb1str :: String+vb1str = "[(1,\"a\"),(2,\"b\"),(3,\"c\")]"++vb2 :: VarBinding Int String+vb2    = makeVarBinding [(3,"c"),(2,"b"),(1,"a")]++vb2str :: String+vb2str = "[(3,\"c\"),(2,\"b\"),(1,\"a\")]"++vb3 :: VarBinding Int String+vb3    = makeVarBinding [(1,"a"),(2,"b"),(3,"c"),(4,"d"),(5,"e")]++vb3str :: String+vb3str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"d\"),(5,\"e\")]"++vb4 :: VarBinding Int String+vb4 = nullVarBinding++vb4str :: String+vb4str = "[]"++vb5 :: VarBinding Int Int+vb5 = makeVarBinding [(1,11),(2,22),(3,33)]++vb6 :: VarBinding Int String+vb6 = makeVarBinding [(3,"cc"),(4,"dd"),(5,"ee")]++vb12, vb13, vb14, vb16, vb21, vb44 :: VarBinding Int String+vb12 = joinVarBindings vb1 vb2+vb13 = joinVarBindings vb1 vb3+vb14 = joinVarBindings vb1 vb4+vb16 = joinVarBindings vb1 vb6+vb21 = joinVarBindings vb2 vb1+vb44 = joinVarBindings vb4 vb4++vb12str, vb13str, vb14str, vb16str, vb21str, vb44str :: String+vb12str = vb1str+vb13str = vb3str+vb14str = vb1str+vb16str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"dd\"),(5,\"ee\")]"+vb21str = vb2str+vb44str = vb4str++testVarBindingSuite :: Test+testVarBindingSuite = +  TestList+  [ test   "testVarBinding01" $ (vb1==vb2)+  , test   "testVarBinding02" $ (vb1/=vb3)+  , test   "testVarBinding03" $ (vb1/=vb4)+  , testEq "testVarBinding04" vb1str  $ show vb1+  , testEq "testVarBinding05" vb2str  $ show vb2+  , testEq "testVarBinding06" vb4str  $ show vb4+  , testEq "testVarBinding10" [1,2,3] $ boundVars vb1+  , testEq "testVarBinding11" [3,2,1] $ boundVars vb2+  , testEq "testVarBinding12" []      $ boundVars vb4+  , test   "testVarBinding20" $ (subBinding vb1 vb2)+  , test   "testVarBinding21" $ (subBinding vb1 vb3)+  , test   "testVarBinding22" $ not (subBinding vb1 vb4)+  , test   "testVarBinding23" $ (subBinding vb2 vb1)+  , test   "testVarBinding24" $ not (subBinding vb3 vb1)+  , test   "testVarBinding25" $ (subBinding vb4 vb1)+  , test   "testVarBinding26" $ (subBinding vb4 vb4)+  , testEq "testVarBinding30"  0 $ applyVarBinding vb5 0+  , testEq "testVarBinding31" 11 $ applyVarBinding vb5 1+  , testEq "testVarBinding32" 22 $ applyVarBinding vb5 2+  , testEq "testVarBinding33" 33 $ applyVarBinding vb5 3+  , testEq "testVarBinding34"  4 $ applyVarBinding vb5 4+  , testEq "testVarBinding35" 11 $ applyVarBinding vb5 11+  , test   "testVarBinding40" $ not (vbNull vb12)+  , test   "testVarBinding41" $ not (vbNull vb13)+  , test   "testVarBinding42" $ not (vbNull vb14)+  , test   "testVarBinding43" $ not (vbNull vb16)+  , test   "testVarBinding44" $ not (vbNull vb21)+  , test   "testVarBinding45" $ (vbNull vb44)+  , test   "testVarBinding50" $ (subBinding vb12 vb13)+  , test   "testVarBinding51" $ (subBinding vb12 vb14)+  , test   "testVarBinding52" $ (subBinding vb12 vb16)+  , test   "testVarBinding53" $ (subBinding vb12 vb21)+  , test   "testVarBinding54" $ not (subBinding vb12 vb44)+  , test   "testVarBinding55" $ not (subBinding vb13 vb12)+  , test   "testVarBinding56" $ (subBinding vb14 vb12)+  , test   "testVarBinding57" $ (subBinding vb44 vb12)+  , test   "testVarBinding58" $ not (subBinding vb16 vb12)+  , testEq "testVarBinding60" vb12str $ show vb12+  , testEq "testVarBinding61" vb13str $ show vb13+  , testEq "testVarBinding62" vb14str $ show vb14+  , testEq "testVarBinding63" vb16str $ show vb16+  , testEq "testVarBinding64" vb21str $ show vb21+  , testEq "testVarBinding65" vb44str $ show vb44+  , testEq "testVarBinding70" (Just "a")  $ vbMap vb16 1+  , testEq "testVarBinding71" (Just "c")  $ vbMap vb16 3+  , testEq "testVarBinding72" (Just "ee") $ vbMap vb16 5+  , testEq "testVarBinding73" Nothing     $ vbMap vb16 7+  ]++------------------------------------------------------------+--  Variable binding modifier tests+------------------------------------------------------------++vb1m :: VarBinding String Int+vb1m    = makeVarBinding [("a",1)]++vb2m :: VarBinding String Int+vb2m    = makeVarBinding [("a",1),("b",2)]++vb3m :: VarBinding String Int+vb3m    = makeVarBinding [("a",1),("c",3)]++vb4m :: VarBinding String Int+vb4m    = makeVarBinding [("b",2),("c",3)]++vb5m :: VarBinding String Int+vb5m    = makeVarBinding [("a",1),("b",2),("c",3)]++vb6m :: VarBinding String Int+vb6m    = makeVarBinding [("a",1),("b",2),("c",4)]++vb9m :: VarBinding String Int+vb9m    = makeVarBinding [("i",9)]++-- Add new bindings per vb9m+vbm1 :: VarBindingModify String Int+vbm1 = VarBindingModify+    { vbmName  = swishName "vbm1"+    , vbmApply = map (\vb -> joinVarBindings vb vb9m)+    , vbmVocab = boundVars vb9m+    , vbmUsage = [boundVars vb9m]+    }++vb1m1, vb2m1 :: VarBinding String Int+[vb1m1] = vbmApply vbm1 [vb1m]+[vb2m1] = vbmApply vbm1 [vb2m]++-- Filter for bindings that define a+vbm2 :: VarBindingModify String Int+vbm2 = VarBindingModify+    { vbmName  = swishName "vbm2"+    , vbmApply = filter (\vb -> isJust $ vbMap vb "a")+    , vbmVocab = ["a"]+    , vbmUsage = [[]]+    }++vb12m2 :: [VarBinding String Int]+vb12m2 = vbmApply vbm2 [vb1m,vb2m,vb9m]++-- Filter or add bindings so that a+b=c+vbm3 :: VarBindingModify String Int+vbm3 = VarBindingModify+    { vbmName  = swishName "vbm3"+    , vbmApply = sumBinding "a" "b" "c"+    , vbmVocab = ["a","b","c"]+    , vbmUsage = [[],["a"],["b"],["c"]]+    }++sumBinding :: String -> String -> String -> [VarBinding String Int]+    -> [VarBinding String Int]+sumBinding va vb vc vbinds = concatMap abSumc vbinds+    where+        abSumc :: VarBinding String Int -> [VarBinding String Int]+        abSumc vbind =+            abSumc1 (vbMap vbind va) (vbMap vbind vb) (vbMap vbind vc) vbind+        abSumc1 (Just a) (Just b) (Just c) vbind+            | (a+b) == c = [vbind]+            | otherwise  = []+        abSumc1 (Just a) (Just b) Nothing vbind  =+            [ joinVarBindings vbind  $ makeVarBinding [(vc,a+b)] ]+        abSumc1 (Just a) Nothing (Just c) vbind  =+            [ joinVarBindings vbind  $ makeVarBinding [(vb,c-a)] ]+        abSumc1 Nothing (Just b) (Just c) vbind  =+            [ joinVarBindings vbind  $ makeVarBinding [(va,c-b)] ]+        abSumc1 _ _ _ _ = []++vb16m3 :: [VarBinding String Int]+vb16m3 = vbmApply vbm3 [vb1m,vb2m,vb3m,vb4m,vb5m,vb6m]++testVarModifySuite :: Test+testVarModifySuite = +  TestList+  [ testEq "testVarModifyName01"+      (swishName "vbm1") $ vbmName vbm1 +  , testEq "testVarModify01" (Just 1) $ vbMap vb1m1 "a"+  , testEq "testVarModify02" Nothing  $ vbMap vb1m1 "b"+  , testEq "testVarModify03" Nothing  $ vbMap vb2m1 "c"+  , testEq "testVarModify04" (Just 9) $ vbMap vb1m1 "i"+  , testEq "testVarModify05" (Just 1) $ vbMap vb2m1 "a"+  , testEq "testVarModify06" (Just 2) $ vbMap vb2m1 "b"+  , testEq "testVarModify07" Nothing  $ vbMap vb2m1 "c"+  , testEq "testVarModify08" (Just 9) $ vbMap vb2m1 "i"+  , testEq "testVarModify10" (Just ["i"]) $+      vbmCompatibility vbm1 ["a","b"]+  , testEq "testVarModify11" Nothing $+      vbmCompatibility vbm1 ["a","b","i"]+  , testEq "testVarModifyName02"+      (swishName "vbm2") $ vbmName vbm2+  , testEq "testVarModify20" 2 $ length vb12m2+  , testEq "testVarModify21" vb1m $ vb12m2!!0+  , testEq "testVarModify22" vb2m $ vb12m2!!1+  , testEq "testVarModify23" (Just []) $+      vbmCompatibility vbm2 ["a","b"]+  , testEq "testVarModify24" (Just []) $+      vbmCompatibility vbm2 ["a","b"]+  , testEq "testVarModify25" (Just []) $+      vbmCompatibility vbm2 ["a","b","i"]+  , testEq "testVarModify26" Nothing $+      vbmCompatibility vbm2 ["i"]+  , testEq "testVarModifyName03"+      (swishName "vbm3") $ vbmName vbm3+  , testEq "testVarModify30" 4 $ length vb16m3+  , testEq "testVarModify31" vb5m $ (vb16m3!!0)+  , testEq "testVarModify32" vb5m $ (vb16m3!!1)+  , testEq "testVarModify33" vb5m $ (vb16m3!!2)+  , testEq "testVarModify34" vb5m $ (vb16m3!!3)+  , testEq "testVarModify35" (Just ["c"]) $+      vbmCompatibility vbm3 ["a","b"]+  , testEq "testVarModify36" (Just ["b"]) $+      vbmCompatibility vbm3 ["a","c"]+  , testEq "testVarModify37" (Just ["a"]) $+      vbmCompatibility vbm3 ["b","c","i"]+  , testEq "testVarModify38" (Just []) $+      vbmCompatibility vbm3 ["i","c","a","b"]+  , testEq "testVarModify39" Nothing $+      vbmCompatibility vbm3 ["i","a"]+  , testEq "testVarModify40" Nothing $+      vbmCompatibility vbm3 ["i","b"]+  , testEq "testVarModify41" Nothing $+      vbmCompatibility vbm3 ["i","c"]+  , testEq "testVarModify42" Nothing $+      vbmCompatibility vbm3 ["i","d"]+  ]++------------------------------------------------------------+--  Variable binding modifier composition tests+------------------------------------------------------------++--  Given (1) a+b=c and (2) a+c=d, then:+--    a=1 b=2   =>   c=3 d=4   by (1) then (2)+--    a=1 c=3   =>   b=2 d=4   by (1) then (2) or (2) then (1)+--    a=1 d=4   =>   b=2 c=3   by (2) then (1)+--    b=2 c=3   =>   a=1 d=4   by (1) then (2)+--    b=2 d=4   =>   insufficient data+--    c=3 d=4   =>   a=1 b=2   by (2) then (1)+++-- Filter or add bindings so that a+b=c+vbm4 :: VarBindingModify String Int+vbm4 = VarBindingModify+    { vbmName  = swishName "vbm4"+    , vbmApply = sumBinding "a" "c" "d"+    , vbmVocab = ["a","c","d"]+    , vbmUsage = [[],["a"],["c"],["d"]]+    }++vbm34, vbm43 :: VarBindingModify String Int+Just vbm34 = vbmCompose vbm3 vbm4+Just vbm43 = vbmCompose vbm4 vbm3++vbm34vocab, vbm43vocab :: [String]+vbm34vocab = [ "a", "b", "c", "d"]+vbm43vocab = [ "a", "b", "c", "d"]++vbm34usage, vbm43usage :: [[String]]+vbm34usage = [ ["a","d"], ["b","d"], ["c","d"]+             , ["a"], ["b"], ["c"], ["d"], []+             ]+vbm43usage = [ ["a","b"], ["b","c"], ["b","d"]+             , ["a"], ["b"], ["c"], ["d"], []+             ]++vbab :: VarBinding String Int+vbab    = makeVarBinding [("a",1),("b",2)]++vbac :: VarBinding String Int+vbac    = makeVarBinding [("a",1),("c",3)]++vbad :: VarBinding String Int+vbad    = makeVarBinding [("a",1),("d",4)]++vbbc :: VarBinding String Int+vbbc    = makeVarBinding [("b",2),("c",3)]++vbbd :: VarBinding String Int+vbbd    = makeVarBinding [("b",2),("d",4)]++vbcd :: VarBinding String Int+vbcd    = makeVarBinding [("c",3),("d",4)]++vbabcd :: VarBinding String Int+vbabcd    = makeVarBinding [("a",1),("b",2),("c",3),("d",4)]+++-- [[[need test for incompatible composition]]] --+--  Three ways to be incompatible:+--  (a) both modifers define same new output+--  (b) output from second modifier is input to first modifier++vbm5 :: VarBindingModify String Int+vbm5 = VarBindingModify+    { vbmName  = swishName "vbm5"+    , vbmApply = id                 -- incorrect: dummy for testing only+    , vbmVocab = ["a","b","c"]+    , vbmUsage = [["a"],["b"]]+    }++vbm6 :: VarBindingModify String Int+vbm6 = VarBindingModify+    { vbmName  = swishName "vbm6"+    , vbmApply = id                 -- incorrect: dummy for testing only+    , vbmVocab = ["a","b","c"]+    , vbmUsage = [["a","b"],["b","c"],["a","c"]]+    }++vbm7 :: VarBindingModify String Int+vbm7 = VarBindingModify+    { vbmName  = swishName "vbm7"+    , vbmApply = id                 -- incorrect: dummy for testing only+    , vbmVocab = ["a","b","c"]+    , vbmUsage = [["a"]]+    }++vbm8 :: VarBindingModify String Int+vbm8 = VarBindingModify+    { vbmName  = swishName "vbm8"+    , vbmApply = id                 -- incorrect: dummy for testing only+    , vbmVocab = ["b","c","d"]+    , vbmUsage = [["b"],["c"],["b","c"]]+    }++vbm56, vbm65, vbm78, vbm87 ::  Maybe (VarBindingModify String Int)++vbm56 = vbmCompose vbm5 vbm6+vbm65 = vbmCompose vbm6 vbm5+vbm78 = vbmCompose vbm7 vbm8+vbm87 = vbmCompose vbm8 vbm7++vbm87usage :: [[String]]+vbm87usage = [["a","b"],["a","c"],["a","b","c"]]++jvbm1id, jvbmid1 :: Maybe (VarBindingModify String Int)+jvbm1id    = vbmCompose vbm1 varBindingId+jvbmid1    = vbmCompose varBindingId vbm1++vb1m1id, vb2m1id, vb1mid1, vb2mid1 :: VarBinding String Int+[vb1m1id] = vbmApply (fromJust jvbm1id) [vb1m]+[vb2m1id] = vbmApply (fromJust jvbm1id) [vb2m]++[vb1mid1] = vbmApply (fromJust jvbmid1) [vb1m]+[vb2mid1] = vbmApply (fromJust jvbmid1) [vb2m]++testVarComposeSuite :: Test+testVarComposeSuite = +  TestList+  [ testEq "testVarModifyName04" (swishName "vbm4") $ vbmName vbm4+  , testEq "testVarModifyName05" (swishName "_vbm4_vbm3_") $ vbmName vbm43+  , testEq "testVarModifyName06" (swishName "_vbm3_vbm4_") $ vbmName vbm34+  , testEq "testVarModifyName07" (swishName "_vbm1_varBindingId_") $+                        vbmName (fromJust jvbm1id)+  , testEq "testVarModifyName08" (swishName "_varBindingId_vbm1_") $+                        vbmName (fromJust jvbmid1)++  , testEqv "testVarCompose01" vbm34vocab $ vbmVocab vbm34+  , testEqvEqv "testVarCompose02" vbm34usage $ vbmUsage vbm34+  , testMaybeEqv "testVarCompose03" (Just ["c","d"]) $+     vbmCompatibility vbm34 ["a","b"]+  , testMaybeEqv "testVarCompose04" (Just ["b","d"]) $+     vbmCompatibility vbm34 ["a","c"]+  , testMaybeEqv "testVarCompose05" Nothing $+     vbmCompatibility vbm34 ["a","d"]+  , testMaybeEqv "testVarCompose06" (Just ["a","d"]) $+     vbmCompatibility vbm34 ["b","c"]+  , testMaybeEqv "testVarCompose07" Nothing $+     vbmCompatibility vbm34 ["b","d"]+  , testMaybeEqv "testVarCompose08" Nothing $+     vbmCompatibility vbm34 ["c","d"]+  , testMaybeEqv "testVarCompose09" (Just ["a"]) $+     vbmCompatibility vbm34 ["b","c","d"]+  , testMaybeEqv "testVarCompose10" (Just ["b"]) $+     vbmCompatibility vbm34 ["a","c","d"]+  , testMaybeEqv "testVarCompose11" (Just ["c"]) $+     vbmCompatibility vbm34 ["a","b","d"]+  , testMaybeEqv "testVarCompose12" (Just ["d"]) $+     vbmCompatibility vbm34 ["a","b","c"]+  , testMaybeEqv "testVarCompose13" (Just []) $+     vbmCompatibility vbm34 ["a","b","c","d"]+  , testEqv "testVarCompose14" [vbabcd,vbabcd,vbabcd] $+     vbmApply vbm34 [vbab,vbac,vbbc]+  , testEqv "testVarCompose15" [] $+     vbmApply vbm34 [vbad,vbbd,vbcd]++  , testEqv "testVarCompose21" vbm43vocab $ vbmVocab vbm43+  , testEqvEqv "testVarCompose22" vbm43usage $ vbmUsage vbm43+  , testMaybeEqv "testVarCompose23" Nothing $+     vbmCompatibility vbm43 ["a","b"]+  , testMaybeEqv "testVarCompose24" (Just ["b","d"]) $+     vbmCompatibility vbm43 ["a","c"]+  , testMaybeEqv "testVarCompose25" (Just ["b","c"]) $+     vbmCompatibility vbm43 ["a","d"]+  , testMaybeEqv "testVarCompose26" Nothing $+     vbmCompatibility vbm43 ["b","c"]+  , testMaybeEqv "testVarCompose27" Nothing $+     vbmCompatibility vbm43 ["b","d"]+  , testMaybeEqv "testVarCompose28" (Just ["a","b"]) $+     vbmCompatibility vbm43 ["c","d"]+  , testMaybeEqv "testVarCompose29" (Just ["a"]) $+     vbmCompatibility vbm43 ["b","c","d"]+  , testMaybeEqv "testVarCompose30" (Just ["b"]) $+     vbmCompatibility vbm43 ["a","c","d"]+  , testMaybeEqv "testVarCompose31" (Just ["c"]) $+     vbmCompatibility vbm43 ["a","b","d"]+  , testMaybeEqv "testVarCompose32" (Just ["d"]) $+     vbmCompatibility vbm43 ["a","b","c"]+  , testMaybeEqv "testVarCompose33" (Just []) $+     vbmCompatibility vbm43 ["a","b","c","d"]+  , testEqv "testVarCompose34" [] $+     vbmApply vbm43 [vbab,vbbc,vbbd]+  , testEqv "testVarCompose35" [vbabcd,vbabcd,vbabcd] $+     vbmApply vbm43 [vbac,vbad,vbcd]+    +  , test   "testVarCompose41" $ not (isJust vbm56)+  , test   "testVarCompose42" $ not (isJust vbm65)+  , test   "testVarCompose43" $ not (isJust vbm78)+  , test   "testVarCompose44" $     (isJust vbm87)+  , testEqvEqv "testVarCompose45" vbm87usage $+     vbmUsage (fromJust vbm87)++  , test   "testVarCompose51" $ isJust jvbm1id+  , test   "testVarCompose52" $ isJust jvbmid1++  , testEq "testVarCompose61" (Just 1) $ vbMap vb1m1id "a"+  , testEq "testVarCompose62" Nothing  $ vbMap vb1m1id "b"+  , testEq "testVarCompose63" Nothing  $ vbMap vb2m1id "c"+  , testEq "testVarCompose64" (Just 9) $ vbMap vb1m1id "i"+  , testEq "testVarCompose65" (Just 1) $ vbMap vb2m1id "a"+  , testEq "testVarCompose66" (Just 2) $ vbMap vb2m1id "b"+  , testEq "testVarCompose67" Nothing  $ vbMap vb2m1id "c"+  , testEq "testVarCompose68" (Just 9) $ vbMap vb2m1id "i"++  , testEq "testVarCompose71" (Just 1) $ vbMap vb1mid1 "a"+  , testEq "testVarCompose72" Nothing  $ vbMap vb1mid1 "b"+  , testEq "testVarCompose73" Nothing  $ vbMap vb2mid1 "c"+  , testEq "testVarCompose74" (Just 9) $ vbMap vb1mid1 "i"+  , testEq "testVarCompose75" (Just 1) $ vbMap vb2mid1 "a"+  , testEq "testVarCompose76" (Just 2) $ vbMap vb2mid1 "b"+  , testEq "testVarCompose77" Nothing  $ vbMap vb2mid1 "c"+  , testEq "testVarCompose78" (Just 9) $ vbMap vb2mid1 "i"++  ] ++------------------------------------------------------------+--  Modifier composition discovery tests+------------------------------------------------------------++--  vbm3: a+b=c (1)+--  vbm4: a+c=d (2)+--  vbm9: c+d=e (3)+--+--  a,b -> c,d,e  by (1,2,3)+--  a,c -> b,d,e  by (1,2,3)+--         d,b,e  by (2,1,3)+--         d,e,b  by (2,3,1)+--  a,d -> c,b,e  by (2,1,3)+--         c,e,b  by (2,3,1)+--  a,e -> None+--  b,c -> a,d,e  by (1,2,3)+--  b,d -> None+--  b,e -> None+--  c,d -> a,b,e  by (2,1,3)+--      -> a,e,a  by (2,3,1)+--      -> e,a,b  by (3,2,1)+--  c,e -> d,a,b  by (3,2,1)+--  d,e -> c,a,b  by (3,2,1)++vbm9 :: VarBindingModify String Int+vbm9 = VarBindingModify+    { vbmName  = swishName "vbm9"+    , vbmApply = sumBinding "c" "d" "e"+    , vbmVocab = ["c","d","e"]+    , vbmUsage = [[],["c"],["d"],["e"]]+    }++compab, compac, compad, compae,+  compba, compbc, compbd, compbe,+  compca, compcd, compce, compde :: [VarBindingModify String Int]+  +compab = findCompositions [vbm3,vbm4,vbm9] ["a","b"]    -- 1+compac = findCompositions [vbm3,vbm4,vbm9] ["a","c"]    -- 3+compad = findCompositions [vbm3,vbm4,vbm9] ["a","d"]    -- 2+compae = findCompositions [vbm3,vbm4,vbm9] ["a","e"]    -- 0+compba = findCompositions [vbm3,vbm4,vbm9] ["b","a"]    -- 1+compbc = findCompositions [vbm3,vbm4,vbm9] ["b","c"]    -- 1+compbd = findCompositions [vbm3,vbm4,vbm9] ["b","d"]    -- 0+compbe = findCompositions [vbm3,vbm4,vbm9] ["b","e"]    -- 0+compca = findCompositions [vbm3,vbm4,vbm9] ["c","a"]    -- 3+compcd = findCompositions [vbm3,vbm4,vbm9] ["c","d"]    -- 3+compce = findCompositions [vbm3,vbm4,vbm9] ["c","e"]    -- 1+compde = findCompositions [vbm3,vbm4,vbm9] ["d","e"]    -- 1++compvocab :: [String]+compvocab = ["a","b","c","d","e"]++compBindings :: [VarBinding String Int]+compBindings = map makeVarBinding+    [ [ ("a",1), ("b",2) ]+    , [ ("a",1), ("c",3) ]+    , [ ("a",1), ("d",4) ]+    , [ ("a",1), ("e",7) ]+    , [ ("b",2), ("c",3) ]+    , [ ("b",2), ("d",4) ]+    , [ ("b",2), ("e",7) ]+    , [ ("c",3), ("d",4) ]+    , [ ("c",3), ("e",7) ]+    , [ ("d",4), ("e",7) ]+    ]++compResult :: [VarBinding String Int]+compResult = map makeVarBinding+    [ [ ("a",1), ("b",2), ("c",3), ("d",4), ("e",7) ] ]++compApply :: [VarBindingModify String Int] -> [VarBinding String Int]+compApply vbms = (vbmApply (head vbms)) compBindings++jcompab, jcompac, jcompad, jcompae,+  jcompba, jcompbc, jcompbd, jcompbe,+  jcompca, jcompcd, jcompce, jcompde :: Maybe (VarBindingModify String Int)++jcompab = findComposition [vbm3,vbm4,vbm9] ["a","b"]    -- 1+jcompac = findComposition [vbm3,vbm4,vbm9] ["a","c"]    -- 3+jcompad = findComposition [vbm3,vbm4,vbm9] ["a","d"]    -- 1+jcompae = findComposition [vbm3,vbm4,vbm9] ["a","e"]    -- 0+jcompba = findComposition [vbm3,vbm4,vbm9] ["b","a"]    -- 1+jcompbc = findComposition [vbm3,vbm4,vbm9] ["b","c"]    -- 1+jcompbd = findComposition [vbm3,vbm4,vbm9] ["b","d"]    -- 0+jcompbe = findComposition [vbm3,vbm4,vbm9] ["b","e"]    -- 0+jcompca = findComposition [vbm3,vbm4,vbm9] ["c","a"]    -- 3+jcompcd = findComposition [vbm3,vbm4,vbm9] ["c","d"]    -- 3+jcompce = findComposition [vbm3,vbm4,vbm9] ["c","e"]    -- 1+jcompde = findComposition [vbm3,vbm4,vbm9] ["d","e"]    -- 1++testFindCompSuite :: Test+testFindCompSuite = +  TestList+  [ testEq "testVarModifyName08" (swishName "__vbm4_vbm3__vbm9_") $+                        vbmName (compad!!0)+  , testEq "testVarModifyName08" (swishName "__vbm4_vbm9__vbm3_") $+                        vbmName (compad!!1)+ +  , testEq "testFindComp01" 1 $ (length compab)+  , testEq "testFindComp02" 3 $ (length compac)+  , testEq "testFindComp03" 2 $ (length compad)+  , testEq "testFindComp04" 0 $ (length compae)+  , testEq "testFindComp05" 1 $ (length compba)+  , testEq "testFindComp06" 1 $ (length compbc)+  , testEq "testFindComp07" 0 $ (length compbd)+  , testEq "testFindComp08" 0 $ (length compbe)+  , testEq "testFindComp09" 3 $ (length compca)+  , testEq "testFindComp10" 3 $ (length compcd)+  , testEq "testFindComp11" 1 $ (length compce)+  , testEq "testFindComp12" 1 $ (length compde)+    +  , testEqv "testFindComp21" compvocab $ vbmVocab (head compab)+  , testEqv "testFindComp22" compvocab $ vbmVocab (head compac)+  , testEqv "testFindComp23" compvocab $ vbmVocab (head compad)+  , testEqv "testFindComp24" compvocab $ vbmVocab (head compba)+  , testEqv "testFindComp25" compvocab $ vbmVocab (head compbc)+  , testEqv "testFindComp26" compvocab $ vbmVocab (head compca)+  , testEqv "testFindComp27" compvocab $ vbmVocab (head compcd)+  , testEqv "testFindComp28" compvocab $ vbmVocab (head compce)+  , testEqv "testFindComp29" compvocab $ vbmVocab (head compde)++  , testHasEqv "testFindComp31" ["c","d","e"] $ vbmUsage (head compab)+  , testHasEqv "testFindComp32" ["b","d","e"] $ vbmUsage (head compac)+  , testHasEqv "testFindComp33" ["b","c","e"] $ vbmUsage (head compad)+  , testHasEqv "testFindComp34" ["c","d","e"] $ vbmUsage (head compba)+  , testHasEqv "testFindComp35" ["a","d","e"] $ vbmUsage (head compbc)+  , testHasEqv "testFindComp36" ["b","d","e"] $ vbmUsage (head compca)+  , testHasEqv "testFindComp37" ["a","b","e"] $ vbmUsage (head compcd)+  , testHasEqv "testFindComp38" ["a","b","d"] $ vbmUsage (head compce)+  , testHasEqv "testFindComp39" ["a","b","c"] $ vbmUsage (head compde)++  , testEqv "testFindComp41" compResult $ (compApply compab)+  , testEqv "testFindComp42" compResult $ (compApply compac)+  , testEqv "testFindComp43" compResult $ (compApply compad)+  , testEqv "testFindComp44" compResult $ (compApply compba)+  , testEqv "testFindComp45" compResult $ (compApply compbc)+  , testEqv "testFindComp46" compResult $ (compApply compca)+  , testEqv "testFindComp47" compResult $ (compApply compcd)+  , testEqv "testFindComp48" compResult $ (compApply compce)+  , testEqv "testFindComp49" compResult $ (compApply compde)+    +  , testJust    "testFindComp51" jcompab+  , testJust    "testFindComp52" jcompac+  , testJust    "testFindComp53" jcompad+  , testNothing "testFindComp54" jcompae+  , testJust    "testFindComp55" jcompba+  , testJust    "testFindComp56" jcompbc+  , testNothing "testFindComp57" jcompbd+  , testNothing "testFindComp58" jcompbe+  , testJust    "testFindComp59" jcompca+  , testJust    "testFindComp60" jcompcd+  , testJust    "testFindComp61" jcompce+  , testJust    "testFindComp62" jcompde+  ]++------------------------------------------------------------+--  Variable binding filters+------------------------------------------------------------++testFilterBindings :: [VarBinding String Int]+testFilterBindings = map makeVarBinding+    [ [ ("a",0), ("b",2), ("c",2) ]+    , [ ("a",0), ("b",2), ("c",3) ]+    , [ ("a",1), ("b",2), ("c",2) ]+    , [ ("a",1), ("b",2), ("c",3) ]+    , [ ("a",1), ("b",2), ("c",0) ]+    , [ ("a",0), ("b",2), ("c",0) ]+    , [ ("a",4), ("b",2), ("c",4) ]+    , [ ("x",4), ("y",2), ("z",4) ]+    ]++filtertesta0 :: VarBindingModify String Int+filtertesta0 = makeVarFilterModify $+        makeVarTestFilter (swishName "filtertesta0") (==0) "a"+vba0 :: [VarBinding String Int]+vba0 = map makeVarBinding+    [ [ ("a",0), ("b",2), ("c",2) ]+    , [ ("a",0), ("b",2), ("c",3) ]+    , [ ("a",0), ("b",2), ("c",0) ]+    ]++filtertestc0 :: VarBindingModify String Int+filtertestc0 = makeVarFilterModify $+        makeVarTestFilter (swishName "filtertestc0") (==0) "c"+vbc0 :: [VarBinding String Int]+vbc0 = map makeVarBinding+    [ [ ("a",1), ("b",2), ("c",0) ]+    , [ ("a",0), ("b",2), ("c",0) ]+    ]++filtercompabeq :: VarBindingModify String Int+filtercompabeq = makeVarFilterModify $ varFilterEQ "a" "b"+vbabeq :: [VarBinding String Int]+vbabeq = map makeVarBinding+    [ ]++filtercompaceq :: VarBindingModify String Int+filtercompaceq = makeVarFilterModify $ varFilterEQ "a" "c"+vbaceq :: [VarBinding String Int]+vbaceq = map makeVarBinding+    [ [ ("a",0), ("b",2), ("c",0) ]+    , [ ("a",4), ("b",2), ("c",4) ]+    ]++filtercompbceq :: VarBindingModify String Int+filtercompbceq = makeVarFilterModify $ varFilterEQ "b" "c"+vbbceq :: [VarBinding String Int]+vbbceq = map makeVarBinding+    [ [ ("a",0), ("b",2), ("c",2) ]+    , [ ("a",1), ("b",2), ("c",2) ]+    ]++filtercompbcne :: VarBindingModify String Int+filtercompbcne = makeVarFilterModify $ varFilterNE "b" "c"+vbbcne :: [VarBinding String Int]+vbbcne = map makeVarBinding+    [ [ ("a",0), ("b",2), ("c",3) ]+    , [ ("a",1), ("b",2), ("c",3) ]+    , [ ("a",1), ("b",2), ("c",0) ]+    , [ ("a",0), ("b",2), ("c",0) ]+    , [ ("a",4), ("b",2), ("c",4) ]+    ]++filterdisjunct :: VarBindingModify String Int+filterdisjunct = makeVarFilterModify $+                 varFilterDisjunction+                    [ makeVarTestFilter (swishName "isZero") (==0) "a"+                    , varFilterEQ "a" "c"]++filterconjunct :: VarBindingModify String Int+filterconjunct = makeVarFilterModify $+                 varFilterConjunction+                    [ makeVarTestFilter (swishName "isZero") (==0) "a"+                    , varFilterEQ "a" "c"]+                    +                    +vbdisj, vbconj :: [VarBinding String Int]+vbdisj = vbaceq `union` vba0+vbconj = vbaceq `intersect` vba0++testFilterSuite :: Test+testFilterSuite = +  TestList+  [ testEq "testFilterName01" (swishName "filtertesta0") $+      vbmName filtertesta0+  , testEq "testFilterName02" (swishName "filtertestc0") $+     vbmName filtertestc0+  , testEq "testFilterName03" (swishName "varFilterEQ") $+     vbmName filtercompabeq+  , testEq "testFilterName04" (swishName "varFilterNE") $+     vbmName filtercompbcne+  , testEq "testFilterName05" (swishName "varFilterDisjunction") $+     vbmName filterdisjunct+  , testEq "testFilterName06" (swishName "varFilterConjunction") $+     vbmName filterconjunct+    +  , testEqv "testFilter01" vba0   $ vbmApply filtertesta0   testFilterBindings+  , testEqv "testFilter02" vbc0   $ vbmApply filtertestc0   testFilterBindings+  , testEqv "testFilter03" vbabeq $ vbmApply filtercompabeq testFilterBindings+  , testEqv "testFilter04" vbaceq $ vbmApply filtercompaceq testFilterBindings+  , testEqv "testFilter05" vbbceq $ vbmApply filtercompbceq testFilterBindings+  , testEqv "testFilter06" vbbcne $ vbmApply filtercompbcne testFilterBindings+  , testEqv "testFilter07" vbdisj $ vbmApply filterdisjunct testFilterBindings+  , testEqv "testFilter08" vbconj $ vbmApply filterconjunct testFilterBindings++  , testEqv "testFilter10" testFilterBindings $+                vbmApply varBindingId testFilterBindings++  ]++------------------------------------------------------------+--  All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+    [ testVarBindingSuite+    , testVarModifySuite+    , testVarComposeSuite+    , testFindCompSuite+    , testFilterSuite+    ]++main :: IO ()+main = runTestTT allTests >> return ()++{-+runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT+-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------