swish 0.7.0.2 → 0.8.0.0

raw patch · 52 files changed

+1707/−2859 lines, 52 filesdep ~HUnitdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HUnit, base, containers, network, old-locale, semigroups, text, time

API changes (from Hackage documentation)

Files

• app/SwishApp.hs +3/−3
• src/Data/LookupMap.hs +0/−368
• src/Network/URI/Ord.hs +61/−0
• src/Swish/Commands.hs +3/−2
• src/Swish/Datatype.hs +16/−31
• src/Swish/GraphClass.hs +43/−38
• src/Swish/GraphMatch.hs +95/−72
• src/Swish/GraphMem.hs +17/−20
• src/Swish/GraphPartition.hs +8/−1
• src/Swish/Monad.hs +16/−21
• src/Swish/Namespace.hs +15/−15
• src/Swish/Proof.hs +14/−9
• src/Swish/QName.hs +14/−57
• src/Swish/RDF.hs +3/−2
• src/Swish/RDF/BuiltIn/Datatypes.hs +6/−3
• src/Swish/RDF/BuiltIn/Rules.hs +6/−4
• src/Swish/RDF/ClassRestrictionRule.hs +16/−15
• src/Swish/RDF/Formatter/Internal.hs +253/−0
• src/Swish/RDF/Formatter/N3.hs +44/−223
• src/Swish/RDF/Formatter/NTriples.hs +12/−11
• src/Swish/RDF/Formatter/Turtle.hs +36/−248
• src/Swish/RDF/Graph.hs +186/−150
• src/Swish/RDF/Parser/N3.hs +21/−18
• src/Swish/RDF/Parser/Turtle.hs +18/−16
• src/Swish/RDF/Parser/Utils.hs +2/−21
• src/Swish/RDF/Proof.hs +16/−10
• src/Swish/RDF/Query.hs +28/−19
• src/Swish/RDF/Ruleset.hs +18/−15
• src/Swish/RDF/VarBinding.hs +3/−2
• src/Swish/RDF/Vocabulary.hs +3/−0
• src/Swish/Rule.hs +5/−15
• src/Swish/Ruleset.hs +7/−21
• src/Swish/Script.hs +17/−16
• src/Swish/Utils/ListHelpers.hs +1/−33
• src/Swish/VarBinding.hs +57/−67
• swish.cabal +87/−144
• tests/BuiltInMapTest.hs +3/−87
• tests/GraphPartitionTest.hs +2/−46
• tests/GraphTest.hs +194/−222
• tests/LookupMapTest.hs +0/−407
• tests/N3FormatterTest.hs +52/−57
• tests/N3ParserTest.hs +23/−37
• tests/NTTest.hs +10/−9
• tests/QNameTest.hs +1/−1
• tests/RDFDatatypeXsdIntegerTest.hs +15/−17
• tests/RDFGraphTest.hs +129/−121
• tests/RDFProofContextTest.hs +8/−10
• tests/RDFProofTest.hs +5/−4
• tests/RDFQueryTest.hs +42/−45
• tests/RDFRulesetTest.hs +39/−69
• tests/TestHelpers.hs +18/−22
• tests/VarBindingTest.hs +16/−15

@@ -20,7 +20,7 @@ import Data.Version (showVersion)  import System.Environment (getArgs)-import System.Exit (ExitCode(ExitSuccess,ExitFailure), exitWith)+import System.Exit (ExitCode(ExitFailure), exitWith, exitSuccess)  import Control.Monad (unless) @@ -47,7 +47,7 @@       doQuiet = "-q" `elem` flags          if doHelp || doVersion-    then if doHelp then displaySwishHelp else displayVersion >> exitWith ExitSuccess+    then if doHelp then displaySwishHelp else displayVersion >> exitSuccess     else do       unless doQuiet $ displayVersion >> putStrLn "\n"       case validateCommands cmds of@@ -58,7 +58,7 @@         Right acts -> do           code <- runSwishActions acts           case code of-            SwishSuccess -> exitWith ExitSuccess+            SwishSuccess -> exitSuccess             _ -> hPutStrLn stderr ("Swish: "++show code)                  >> exitWith (ExitFailure $ fromEnum code)   

@@ -1,368 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE OverloadedStrings #-}-------------------------------------------------------------------------------------  See end of this file for licence information.------------------------------------------------------------------------------------ |---  Module      :  LookupMap---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 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 Data.LookupMap-    ( LookupEntryClass(..), LookupMap(..)-    , emptyLookupMap, makeLookupMap, listLookupMap-    , reverseLookupMap-    , keyOrder-    , mapFind, mapFindMaybe, mapContains-    , mapReplace, mapReplaceAll, mapReplaceMap-    , mapAdd, mapAddIfNew-    , mapDelete, mapDeleteAll-    , mapEq, mapKeys, mapVals-    , mapMerge-    )-    where--import Control.Arrow (first, second)--import Data.Maybe (fromMaybe)-import Data.Function (on)-import Data.Ord (comparing)--import Swish.Utils.ListHelpers (equiv)--import qualified Data.Foldable as F-import qualified Data.Traversable as T-import qualified Data.List as L--#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 701)-import Data.Tuple (swap)-#else-swap :: (a,b) -> (b,a)-swap (a,b) = (b,a)-#endif-----------------------------------------------------------------  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 = fst . keyVal-        -        entryVal    :: a -> v-        entryVal = snd . keyVal-                             -        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 = newEntry . first f . keyVal-        -        vmap :: (LookupEntryClass a2 k v2) => (v -> v2) -> a -> a2-        vmap f = newEntry . second f . keyVal---- |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----  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).---- |Define a lookup map based on a list of values.----data LookupMap a = LookupMap [a]-  deriving (Functor, F.Foldable, T.Traversable)--{---To allow this Monoid instance, we would need UndecidableInstances.-Also, mapMerge can error out which is not what we would want.--instance (LookupEntryClass a k v, Eq a, Show a, Ord k) => Monoid (LookupMap a) where-    mempty = LookupMap []-    mappend = mapMerge--We could use the following (perhaps with a L.nub on the result before sticling back-into LookupMap) but it is unclear what the semantics are for repeated keys; it is-likely to be left-biased but would leave duplicate keys in the list which could-cause confusion at a later time (e.g. key removal). Many of the routines assume a single-key (or single key,value) pair.--instance (Eq a) => Monoid (LookupMap a) where-    mempty = LookupMap []-    (LookupMap a) `mappend` (LookupMap b) =-        LookupMap (a `mappend` b))--}--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.)----instance (Eq a) => Eq (LookupMap a) where-    (==) = (==) `on` gLM---- |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.----makeLookupMap :: -    (LookupEntryClass a k v) -    => [a]  -- ^ This list is not checked for duplicate entries, or-            -- entries with the same key but different values.-    -> LookupMap a-makeLookupMap = LookupMap---- |Returns a list of lookup map entries.----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 = newEntry . swap . keyVal---- |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 = comparing entryKey---- |Find key in lookup map and return corresponding value,---  otherwise return default supplied.----mapFind :: -    (LookupEntryClass a k v) -    => v    -- ^ The default value.-    -> k -    -> LookupMap a -> v-mapFind def key = fromMaybe def . mapFindMaybe key---- |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 the first 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.----mapReplace :: (LookupEntryClass a k v) =>-    LookupMap a -> a -> LookupMap a-mapReplace (LookupMap []) newe      = LookupMap [newe]-mapReplace (LookupMap (e:es)) newe-    | entryKey e == entryKey newe   = LookupMap (newe:es)-    | otherwise                     = mapAdd more e where-        more = mapReplace (LookupMap es) newe---- |Replace all 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 l@(LookupMap []) _        = l-mapReplaceAll (LookupMap (e:es)) newe   = mapAdd more e' where-    more = mapReplaceAll (LookupMap es) newe-    e'   = if entryKey e == entryKey newe then newe else e---- |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 l@(LookupMap []) _ = l-mapReplaceMap (LookupMap (e:es)) newmap = mapAdd more e' where-    more  = mapReplaceMap (LookupMap es) newmap-    e'    = newEntry (k, mapFind v k newmap)-    (k,v) = keyVal e---- |Add supplied key-value pair to the lookup map.------  This is effectively an optimized case of 'mapReplace' or 'mapAddIfNew',---  where the caller guarantees to avoid duplicate key values.----mapAdd :: LookupMap a -> a -> LookupMap a-mapAdd (LookupMap es) e = LookupMap (e:es)---- |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 mapAdd emap e---- |Delete the first occurrence of the key from the lookup map.------  If the key does not exist in the map then no change is made.----mapDelete :: (LookupEntryClass a k v) =>-    LookupMap a -> k -> LookupMap a-mapDelete l@(LookupMap []) _ = l-mapDelete (LookupMap (e:es)) k-    | k == entryKey e   = LookupMap es-    | otherwise         = mapAdd more e where-        more = mapDelete (LookupMap es) k---- |Delete all occurrences of the key from the lookup map.----mapDeleteAll :: (LookupEntryClass a k v) =>-    LookupMap a -> k -> LookupMap a-mapDeleteAll l@(LookupMap []) _ = l-mapDeleteAll (LookupMap (e:es)) k =-    let more = mapDeleteAll (LookupMap es) k-    in if entryKey e == k then more else mapAdd more e-        --- |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. This is only guaranteed---  if the maps do not contain duplicate entries.----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 distinct keys in a supplied LookupMap----mapKeys :: (LookupEntryClass a k v) =>-    LookupMap a -> [k]-mapKeys = L.nub . gLM . fmap entryKey---- |Return list of distinct values in a supplied LookupMap----mapVals :: (Eq v, LookupEntryClass a k v) =>-    LookupMap a -> [v]-mapVals = L.nub . gLM . fmap entryVal---- |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 a b = LookupMap $ on merge (L.sortBy keyOrder . gLM) a b-    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----------------------------------------------------------------------------------------  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,---    2011, 2012 Douglas Burke---  All rights reserved.------  This file is part of Swish.------  Swish is free software; you can redistribute it and/or modify---  it under the terms of the GNU General Public License as published by---  the Free Software Foundation; either version 2 of the License, or---  (at your option) any later version.------  Swish is distributed in the hope that it will be useful,---  but WITHOUT ANY WARRANTY; without even the implied warranty of---  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the---  GNU General Public License for more details.------  You should have received a copy of the GNU General Public License---  along with Swish; if not, write to:---    The Free Software Foundation, Inc.,---    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA------------------------------------------------------------------------------------

@@ -0,0 +1,61 @@+--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Ord+--  Copyright   :  (c) 2012 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  H98+--+--  Provide an ordering for URIs (that is, an 'Ord' instance for+--  'URI').+--+--  This instance is provided so that URIs can be used as the+--  key of a 'Data.Map.Map'. Case is relevant for the ordering,+--  and no attempt is made to decode percent-encoded values (i.e.+--  the comparison does /not/ use a canonical or normalized form).+--+--------------------------------------------------------------------------------++module Network.URI.Ord () where++import Network.URI (URI(..), URIAuth(..))++-- NOTE: we do not say compare = comparing show for the URI+-- instance since the standard show instance for URIs does not+-- include a password if included as part of the authority field.++instance Ord URI where+    URI s1 a1 o1 q1 f1 `compare` URI s2 a2 o2 q2 f2 =+        (s1,a1,o1,q1,f1) `compare` (s2,a2,o2,q2,f2)++instance Ord URIAuth where+    URIAuth ui1 rn1 p1 `compare` URIAuth ui2 rn2 p2 =+        (ui1,rn1,p1) `compare` (ui2,rn2,p2)++--------------------------------------------------------------------------------+--+--  Copyright (c) 2012 Douglas Burke+--  All rights reserved.+--+--  This file is part of Swish.+--+--  Swish is free software; you can redistribute it and/or modify+--  it under the terms of the GNU General Public License as published by+--  the Free Software Foundation; either version 2 of the License, or+--  (at your option) any later version.+--+--  Swish is distributed in the hope that it will be useful,+--  but WITHOUT ANY WARRANTY; without even the implied warranty of+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+--  GNU General Public License for more details.+--+--  You should have received a copy of the GNU General Public License+--  along with Swish; if not, write to:+--    The Free Software Foundation, Inc.,+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA+--+--------------------------------------------------------------------------------

@@ -63,6 +63,7 @@ import Control.Monad.State (modify, gets) import Control.Monad (liftM, when) +import qualified Data.Set as S import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as IO @@ -126,8 +127,8 @@ diffGraph :: RDFGraph -> SwishStateIO () diffGraph gr = do   oldGr <- gets graph-  let p1 = partitionGraph (getArcs oldGr)-      p2 = partitionGraph (getArcs gr)+  let p1 = partitionGraph (S.toList $ getArcs oldGr)+      p2 = partitionGraph (S.toList $ getArcs gr)       diffs = comparePartitions p1 p2          swishWriteFile (swishOutputDiffs diffs) Nothing

@@ -1,5 +1,4 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}  --------------------------------------------------------------------------------@@ -7,12 +6,13 @@ -------------------------------------------------------------------------------- -- | --  Module      :  Datatype---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  ExistentialQuantification, MultiParamTypeClasses, OverloadedStrings+--  Portability :  ExistentialQuantification, OverloadedStrings -- --  This module defines the structures used to represent and --  manipulate datatypes.  It is designed as a basis for handling datatyped@@ -73,9 +73,9 @@  import Control.Monad (join, liftM) -import Data.LookupMap (LookupEntryClass(..), LookupMap(..), mapFindMaybe) import Data.Maybe (isJust, catMaybes) +import qualified Data.Map as M import qualified Data.Text as T  ------------------------------------------------------------@@ -88,12 +88,6 @@ -- 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@@ -241,13 +235,15 @@ getDTRel ::     ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeRel vt) getDTRel nam dtv =-    mapFindMaybe nam (LookupMap (tvalRel dtv))+    let m = M.fromList $ map (\n -> (dtRelName n, n)) (tvalRel dtv)+    in M.lookup nam m  -- | Return the named datatype value modifier, if it exists. getDTMod ::     ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeMod vt lb vn) getDTMod nam dtv =-    mapFindMaybe nam (LookupMap (tvalMod dtv))+    let m = M.fromList $ map (\n -> (dmName n, n)) (tvalMod dtv)+    in M.lookup nam m  -- |Get the canonical form of a datatype value, or @Nothing@. --@@ -310,11 +306,6 @@     , 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.@@ -347,12 +338,6 @@     , 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@@ -417,7 +402,7 @@ --  for the 'VarBindingModify' value can be extracted using an undefined --  label value. ---makeVmod11inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod11inv :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmod11inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -456,7 +441,7 @@ --  for the 'VarBindingModify' value can be extracted using an undefined --  label value. ---makeVmod11 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod11 :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmod11 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -501,7 +486,7 @@ --  for the 'VarBindingModify' value can be extracted using an undefined --  label value. ---makeVmod21inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod21inv :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmod21inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -542,7 +527,7 @@ --  for the 'VarBindingModify' value can be extracted using an undefined --  label value. ---makeVmod21 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod21 :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmod21 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -618,7 +603,7 @@ --  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. ---makeVmod22 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod22 :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmod22 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -658,7 +643,7 @@ --  for the 'VarBindingModify' value can be extracted using an undefined --  label value. ---makeVmodN1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmodN1 :: (Ord lb, Ord vn) => ApplyModifier lb vn makeVmodN1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify     { vbmName   = nam     , vbmApply  = concatMap app1@@ -685,7 +670,7 @@  --  Add value to variable variable binding, if value is singleton list, --  otherwise return empty list.-addv :: (Eq lb, Show lb, Eq vt, Show vt)+addv :: (Ord lb, Ord vt)     => lb -> [vt] -> VarBinding lb vt     -> [VarBinding lb vt] addv lb [val] vbind = [addVarBinding lb val vbind]@@ -693,7 +678,7 @@  --  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)+addv2 :: (Ord lb, Ord vt)     => lb -> lb -> [vt] -> VarBinding lb vt     -> [VarBinding lb vt] addv2 lb1 lb2 [val1,val2] vbind = [addVarBinding lb1 val1 $

@@ -8,7 +8,8 @@ -------------------------------------------------------------------------------- -- | --  Module      :  GraphClass---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke@@ -28,16 +29,20 @@     ( LDGraph(..)     , Label(..)     , Arc(..)+    , ArcSet     , Selector     , arc, arcToTriple, arcFromTriple     , hasLabel, arcLabels -- , arcNodes+    , getComponents     ) where  import Data.Hashable (Hashable(..))-import Data.List (foldl', union, (\\))+import Data.List (foldl')+import Data.Ord (comparing)  import qualified Data.Foldable as F+import qualified Data.Set as S import qualified Data.Traversable as T  --  NOTE:  I wanted to declare this as a subclass of Functor, but@@ -51,48 +56,58 @@ Minimum required implementation:  'emptyGraph', 'setArcs', and 'getArcs'. -}-class (Eq (lg lb), Eq lb ) => LDGraph lg lb where++class LDGraph lg lb where+     -- | Create the empty graph.     emptyGraph  :: lg lb            -- | Replace the existing arcs in the graph.-    setArcs     :: lg lb -> [Arc lb] -> lg lb+    setArcs     :: lg lb -> ArcSet lb -> lg lb          -- | Extract all the arcs from a graph-    getArcs     :: lg lb -> [Arc lb]+    getArcs     :: lg lb -> ArcSet lb          -- | Extract those arcs that match the given `Selector`.-    extract     :: Selector lb -> lg lb -> lg lb-    extract sel = update (filter sel)+    extract     :: (Ord lb) => Selector lb -> lg lb -> lg lb+    extract sel = update (S.filter sel)          -- | Add the two graphs-    addGraphs         :: lg lb -> lg lb -> lg lb-    addGraphs    addg = update (union (getArcs addg))+    addGraphs         :: (Ord lb) => lg lb -> lg lb -> lg lb+    addGraphs    addg = update (S.union (getArcs addg))          -- | Remove those arcs in the first graph from the second     -- graph-    delete :: lg lb  -- ^ g1-              -> lg lb -- ^ g2-              -> lg lb -- ^ g2 - g1 -> g3-    delete delg = update (\\ getArcs delg)+    delete :: +        (Ord lb) =>+        lg lb    -- ^ g1+        -> lg lb -- ^ g2+        -> lg lb -- ^ g2 - g1 -> g3+    delete g1 g2 = setArcs g2 (getArcs g2 `S.difference` getArcs g1)          -- | Enumerate the distinct labels contained in a graph;     -- that is, any label that appears in the subject,     -- predicate or object position of an `Arc`.-    labels      :: lg lb -> [lb]-    labels g    = foldl' union [] (map arcLabels (getArcs g))+    labels      :: (Ord lb) => lg lb -> S.Set lb+    labels = getComponents arcLabels . getArcs          -- | Enumerate the distinct nodes contained in a graph;     -- that is, any label that appears in the subject     -- or object position of an `Arc`.-    nodes       :: lg lb -> [lb]-    nodes g     = foldl' union [] (map arcNodes (getArcs g))+    nodes       :: (Ord lb) => lg lb -> S.Set lb+    nodes = getComponents arcNodes . getArcs          -- | Update the arcs in a graph using a supplied function.-    update      :: ([Arc lb] -> [Arc lb]) -> lg lb -> lg lb+    update      :: (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb     update f g  = setArcs g ( f (getArcs g) ) --- | Label class+-- | Extract components from a set.+getComponents :: (Ord a, Ord b) => (a -> [b]) -> S.Set a -> S.Set b+getComponents f = +    let ins sgr = foldl' (flip S.insert) sgr . f+    in S.foldl' ins S.empty ++-- | 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.@@ -105,8 +120,12 @@ --  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+-- We do not need Ord/Show constraints here, but it means we can just use+-- Label as a short-form for Ord/Show in code++class (Ord lb, Show lb) => Label lb where      -- | Does this node have a variable binding?   labelIsVar  :: lb -> Bool           @@ -124,9 +143,6 @@   -- | Make a label value from a local id.     makeLabel   :: String -> lb     -  -- compare     :: lb -> lb -> Ordering-  -- compare l1 l2 = compare (show l1) (show l2)- -- | Arc type. -- -- Prior to @0.7.0.0@ you could also use @asubj@, @apred@ and @aobj@@@ -139,6 +155,9 @@               }             deriving (Eq, Functor, F.Foldable, T.Traversable) +-- | A set - or graph - of arcs.+type ArcSet lb = S.Set (Arc lb)+ instance (Hashable lb) => Hashable (Arc lb) where   hash (Arc s p o) = hash s `hashWithSalt` p `hashWithSalt` o   hashWithSalt salt (Arc s p o) = salt `hashWithSalt` s `hashWithSalt` p `hashWithSalt` o@@ -159,21 +178,7 @@ 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--  {- not needed-  (Arc s1 p1 o1) <= (Arc s2 p2 o2)-    | s1 /= s2 = s1 <= s2-    | p1 /= p2 = p1 <= p2-    | otherwise = o1 <= o2-  -}+    compare = comparing arcToTriple  instance (Show lb) => Show (Arc lb) where     show (Arc lb1 lb2 lb3) =

@@ -1,5 +1,5 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}  --------------------------------------------------------------------------------@@ -12,7 +12,7 @@ -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses+--  Portability :  CPP, FlexibleInstances, MultiParamTypeClasses -- --  This module contains graph-matching logic. --@@ -33,24 +33,21 @@         graphMatch1, graphMatch2, equivalenceClasses, reclassify       ) where -import Swish.GraphClass (Arc(..), Label(..))-import Swish.GraphClass (arcLabels, hasLabel, arcToTriple)--import Swish.Utils.ListHelpers (equiv)+import Swish.GraphClass (Arc(..), ArcSet, Label(..))+import Swish.GraphClass (getComponents, arcLabels, hasLabel, arcToTriple)  import Control.Exception.Base (assert) import Control.Arrow (second) -import Data.Ord (comparing)-import Data.List (foldl', nub, sortBy, groupBy, partition)-import Data.LookupMap (LookupEntryClass(..), LookupMap(..))-import Data.LookupMap (makeLookupMap, listLookupMap, mapFind, mapReplaceAll,-                       mapAddIfNew, mapReplaceMap, mapMerge)-import Data.Function (on)  +import Data.Function (on) import Data.Hashable (combine)+import Data.List (foldl', sortBy, groupBy, partition)+import Data.Ord (comparing) import Data.Word  import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -------------------------- --  Label index value type@@ -80,22 +77,19 @@ -- | A label associated with a 'LabelIndex' 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, Show lv) => Show (GenLabelEntry lb lv) where+    show (LabelEntry k v) = show k ++ ":" ++ show v -instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)-    => Show (GenLabelEntry lb lv) where-    show = entryShow+instance (Label lb, Eq lv) => Eq (GenLabelEntry lb lv) where+    (LabelEntry k1 v1) == (LabelEntry k2 v2) = (k1,v1) == (k2,v2) -instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)-    => Eq (GenLabelEntry lb lv) where-    (==) = entryEq+instance (Label lb, Show lv, Ord lv) => Ord (GenLabelEntry lb lv) where+    (LabelEntry lb1 lv1) `compare` (LabelEntry lb2 lv2) =+        (lb1, lv1) `compare` (lb2, lv2)  -- | Type for label->index lookup table data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =-    LabelMap Word32 (LookupMap (GenLabelEntry lb lv))+    LabelMap Word32 (M.Map lb lv)  -- | A label lookup table specialized to 'LabelIndex' indices. type LabelMap lb = GenLabelMap lb LabelIndex@@ -105,14 +99,11 @@  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+      (gen1, lmap1) == (gen2, lmap2)  -- | The empty label map table. emptyMap :: (Label lb) => LabelMap lb-emptyMap = LabelMap 1 $ makeLookupMap []+emptyMap = LabelMap 1 M.empty  -------------------------- --  Equivalence class type@@ -160,6 +151,8 @@ pairSort :: (Ord a) => [(a,b)] -> [(a,b)] pairSort = sortBy (comparing fst) +-- TODO: use set on input+ -- | Group the pairs based on the first argument. pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])] pairGroup = map (factor . unzip) . groupBy eqFirst . pairSort @@ -218,6 +211,8 @@  -- QUS: why doesn't this return Maybe (LabelMap (ScopedLabel lb)) ? +-- TODO: Should this use Set (Arc lb) instead of [Arc lb]?+ -- | Graph matching function accepting two lists of arcs and --  returning a node map if successful --@@ -228,8 +223,8 @@     --   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+    -> ArcSet lb -- ^ the first graph to be compared+    -> ArcSet lb -- ^ the second graph to be compared     -> (Bool, LabelMap (ScopedLabel lb))     -- ^ If the first element is `True` then the second element maps each label     --   to an equivalence class identifier, otherwise it is just@@ -237,8 +232,8 @@     -- graphMatch matchable gs1 gs2 =     let-        sgs1    = {- trace "sgs1 " $ -} map (makeScopedArc 1) gs1-        sgs2    = {- trace "sgs2 " $ -} map (makeScopedArc 2) gs2+        sgs1    = {- trace "sgs1 " $ -} S.map (makeScopedArc 1) gs1+        sgs2    = {- trace "sgs2 " $ -} S.map (makeScopedArc 2) gs2         ls1     = {- traceShow "ls1 " $ -} graphLabels sgs1         ls2     = {- traceShow "ls2 " $ -} graphLabels sgs2         lmap    = {- traceShow "lmap " $ -}@@ -281,10 +276,10 @@   -- ^ 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] +  -> ArcSet lb    -- ^ (@gs1@ argument)   --   first of two lists of arcs (triples) to be compared-  -> [Arc lb]+  -> ArcSet lb   -- ^ (@gs2@ argument)   --   secind of two lists of arcs (triples) to be compared   -> LabelMap lb@@ -370,8 +365,10 @@ --  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)]+    -> ArcSet lb+    -> ArcSet 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) =@@ -416,12 +413,13 @@     "LabelMap gen="++ Prelude.show gn ++", map="++     foldl' (++) "" (map (("\n    "++) . Prelude.show) es)     where-        es = listLookupMap lmap+        es = M.toList lmap --- | Map a label to its corresponding label index value in the supplied LabelMap+-- | 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+mapLabelIndex (LabelMap _ lxms) lb = M.findWithDefault nullLabelVal lb lxms  -- | Confirm that a given pair of labels are matchable, and are --  mapped to the same value by the supplied label map@@ -429,7 +427,7 @@ 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)+    matchable l1 l2 && (mapLabelIndex lmap l1 == mapLabelIndex lmap l2)  -- | 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@@ -448,7 +446,7 @@ setLabelHash :: (Label lb)     => LabelMap lb -> (lb, Word32) -> LabelMap lb setLabelHash  (LabelMap g lmap) (lb,lh) =-    LabelMap g ( mapReplaceAll lmap $ newEntry (lb,(g,lh)) )+    LabelMap g $ M.insert lb (g,lh) lmap  -- | Increment the generation of the label map. --@@ -468,13 +466,12 @@ --  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+assignLabelMap :: (Label lb) => S.Set lb -> LabelMap lb -> LabelMap lb+assignLabelMap ns lmap = S.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))+assignLabelMap1 lab (LabelMap g lvs) = +    LabelMap g $ M.insertWith (flip const) lab (g, initVal lab) lvs  --  Calculate initial value for a node @@ -490,11 +487,11 @@ -- using the label map. equivalenceClasses ::    (Label lb) -  => LabelMap lb -- ^ label map-  -> [lb]        -- ^ list of nodes to be reclassified+  => LabelMap lb     -- ^ label map+  -> S.Set lb        -- ^ nodes to be reclassified   -> [EquivalenceClass lb] equivalenceClasses lmap ls =-    pairGroup $ map labelPair ls+    pairGroup $ S.toList $ S.map labelPair ls     where         labelPair l = (mapLabelIndex lmap l,l) @@ -510,12 +507,12 @@ -- reclassify ::    (Label lb) -  => [Arc lb] -  -- ^ (the @gs1@ argument) the first of two lists of arcs (triples) to perform a+  => ArcSet lb +  -- ^ (the @gs1@ argument) the first of two sets of arcs 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+  -> ArcSet lb+  -- ^ (the @gs2@ argument) the second of two sets of arcs to perform a   --   basis for reclassifying the labels in the second equivalence   --   class in each pair of the @ecpairs@ argument   -> LabelMap lb @@ -548,7 +545,8 @@             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++        lm' = classifyCombine lm $ M.union lm1 lm2                  tmap f (a,b) = (f a, f b)         @@ -561,14 +559,24 @@         pairEq = uncurry (==)         pairG1 (p1,p2) = p1 > 1 || p2 > 1         remapEc = pairGroup . map (newIndex lm') . pairUngroup -        newIndex x (_,lab) = (mapFind nullLabelVal lab x,lab)+        newIndex x (_,lab) = (M.findWithDefault nullLabelVal lab x,lab) --- | Calculate a new index value for a supplied list of labels based on the+-- Replace the values in lm1 with those from lm2, but do not copy over new+-- keys from lm2+classifyCombine :: (Ord a) => M.Map a b -> M.Map a b -> M.Map a b+#if MIN_VERSION_containers(0,5,0)+classifyCombine = M.mergeWithKey (\_ _ v -> Just v) id (const M.empty)+#else+-- rely on the left-biased nature of union+classifyCombine lm1 lm2 = M.intersection lm2 lm1 `M.union` lm1+#endif++-- | Calculate a new index value for a supplied set 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+  => ArcSet 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@@ -576,17 +584,20 @@   -- for the given graph labels. The label map generation number is   -- incremented by 1. remapLabels gs lmap@(LabelMap gen _) ls =-    LabelMap gen' (LookupMap newEntries)+    LabelMap gen' $ M.fromList newEntries     where         gen'                = gen+1-        newEntries          = [ newEntry (l, (gen', fromIntegral (newIndex l))) | l <- ls ]+        newEntries          = [ (l, (gen', fromIntegral (newIndex l))) | l <- ls ]         newIndex l             | labelIsVar l  = mapAdjacent l                 -- adjacency classifies variable labels             | otherwise     = hashVal (fromIntegral gen) l  -- otherwise rehash (to disentangle collisions)         -- mapAdjacent l       = sum (sigsOver l) `rem` hashModulus         mapAdjacent l       = sum (sigsOver l) `combine` hashModulus -- is this a sensible replacement for `rem` MH.hashModulus        -        sigsOver l          = select (hasLabel l) gs (arcSignatures lmap gs) +        gls = S.toList gs++        sigsOver l          = select (hasLabel l) gls (arcSignatures lmap gls)+ -- |Select is like filter, except that it tests one list to select --  elements from a second list. select :: ( a -> Bool ) -> [a] -> [b] -> [b]@@ -596,17 +607,20 @@     | otherwise = select f l1 l2 select _ _ _    = error "select supplied with different length lists" ---- | Return list of distinct labels used in a graph+-- | Return the set of distinct labels used in the graph. -graphLabels :: (Label lb) => [Arc lb] -> [lb]-graphLabels = nub . concatMap arcLabels+graphLabels :: (Label lb) => ArcSet lb -> S.Set lb+graphLabels = getComponents arcLabels  -- TODO: worry about overflow? --- | 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.+-- TODO: should probably return a Set of (Int, Arc lb) or something, +-- as may be useful for the calling code++-- | 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) @@ -632,10 +646,14 @@ --  Used for testing for graph equivalence under a supplied --  label mapping;  e.g. -----  >  if ( graphMap nodeMap gs1 ) `equiv` ( graphMap nodeMap gs2 ) then (same)+--  >  if ( graphMap nodeMap gs1 ) == ( graphMap nodeMap gs2 ) then (same) ---graphMap :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc LabelIndex]-graphMap = map . fmap . mapLabelIndex  -- graphMapStmt+graphMap ::+    (Label lb)+    => LabelMap lb+    -> ArcSet lb+    -> ArcSet LabelIndex+graphMap = S.map . fmap . mapLabelIndex  -- | Compare a pair of graphs for equivalence under a given mapping --   function.@@ -646,8 +664,13 @@ --  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+graphMapEq ::+    (Label lb) +    => LabelMap lb+    -> ArcSet lb+    -> ArcSet lb +    -> Bool+graphMapEq lmap = (==) `on` (graphMap lmap)  -------------------------------------------------------------------------------- --

@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -9,12 +6,13 @@ -------------------------------------------------------------------------------- -- | --  Module      :  GraphMem---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  DeriveFoldable, DeriveFunctor, DeriveTraversable, FlexibleInstances, MultiParamTypeClasses+--  Portability :  FlexibleInstances, MultiParamTypeClasses -- --  This module defines a simple memory-based graph instance. --@@ -40,22 +38,23 @@ import Data.Monoid (Monoid(..)) import Data.Ord (comparing) -import qualified Data.Foldable as F-import qualified Data.Traversable as T+import qualified Data.Set as S  -- | Simple memory-based graph type.  -data GraphMem lb = GraphMem { arcs :: [Arc lb] }-                   deriving (Functor, F.Foldable, T.Traversable)-                            +data GraphMem lb = GraphMem { arcs :: ArcSet lb }+ instance (Label lb) => LDGraph GraphMem lb where-    emptyGraph   = GraphMem []+    emptyGraph   = GraphMem S.empty     getArcs      = arcs     setArcs g as = g { arcs=as }  instance (Label lb) => Eq (GraphMem lb) where     (==) = graphEq +instance (Label lb) => Ord (GraphMem lb) where+    compare = comparing getArcs+ instance (Label lb) => Show (GraphMem lb) where     show = graphShow @@ -64,12 +63,7 @@     mappend = addGraphs  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 }--}+graphShow g = "Graph:" ++ S.foldr ((++) . ("\n    " ++) . show) "" (arcs g)  -- |  Return Boolean graph equality @@ -139,12 +133,15 @@     (LV l1) == (LV l2)  = l1 == l2     _ == _              = False +instance Ord LabelMem where+    (LF l1) `compare` (LF l2) = l1 `compare` l2+    (LV l1) `compare` (LV l2) = l1 `compare` l2+    (LF _)  `compare` _       = LT+    _       `compare` (LF _)  = GT+ instance Show LabelMem where     show (LF l1)        = '!' : l1     show (LV l2)        = '?' : l2--instance Ord LabelMem where-    compare = comparing show   -------------------------------------------------------------------------------- --

@@ -50,7 +50,7 @@ --    'PartObj' constructors.  data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]-    deriving (Eq,Show)+    deriving (Eq, Show)  -- | Returns all the arcs in the partitioned graph. getArcs :: PartitionedGraph lb -> [Arc lb]@@ -87,6 +87,13 @@     (PartObj o1)    == (PartObj o2)    = o1 == o2     (PartSub s1 p1) == (PartSub s2 p2) = s1 == s2 && p1 == p2     _               == _               = False++-- Chose ordering to be "more information" first/smaller (arbitrary choice).+instance (Label lb) => Ord (GraphPartition lb) where+    (PartSub s1 p1) `compare` (PartSub s2 p2) = (s1,p1) `compare` (s2,p2)+    (PartObj o1)    `compare` (PartObj o2)    = o1 `compare` o2+    (PartSub _ _)   `compare` _               = LT+    _               `compare` (PartSub _ _)   = GT  instance (Label lb) => Show (GraphPartition lb) where     show = partitionShow

@@ -1,17 +1,15 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}- -------------------------------------------------------------------------------- --  See end of this file for licence information. -------------------------------------------------------------------------------- -- | --  Module      :  Monad---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  FlexibleInstances, MultiParamTypeClasses+--  Portability :  H98 -- --  Composed state and IO monad for Swish --@@ -20,7 +18,6 @@ module Swish.Monad     ( SwishStateIO, SwishState(..), SwishStatus(..)     , SwishFormat(..)-    , NamedGraph(..)     , NamedGraphMap     -- * Create and modify the Swish state     , emptyState@@ -31,7 +28,6 @@     , findOpenVarModify, findDatatype     , setInfo, resetInfo, setError, resetError     , setStatus-    -- , setVerbose     -- * Error handling     , swishError     , reportLine@@ -53,11 +49,12 @@ import Control.Monad.Trans (MonadTrans(..)) import Control.Monad.State (StateT(..), modify) -import Data.LookupMap (LookupEntryClass(..), LookupMap(..))-import Data.LookupMap (emptyLookupMap, mapFindMaybe, mapVals)+import Data.List (nub)  import System.IO (hPutStrLn, stderr) +import qualified Data.Map as M+ {-| The supported input and output formats. -}@@ -116,8 +113,8 @@     { format    = N3     , base      = Nothing     , graph     = emptyRDFGraph-    , graphs    = emptyLookupMap-    , rules     = emptyLookupMap+    , graphs    = M.empty+    , rules     = M.empty     , rulesets  = rdfRulesetMap     , infomsg   = Nothing     , errormsg  = Nothing@@ -143,13 +140,13 @@  -- | Find a named graph. findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]-findGraph nam state = mapFindMaybe nam (graphs state)+findGraph nam state = M.lookup nam (graphs state)  -- | Find a formula. The search is first made in the named graphs -- and then, if not found, the rulesets. findFormula :: ScopedName -> SwishState -> Maybe RDFFormula findFormula nam state = case findGraph nam state of-        Nothing  -> getMaybeContextAxiom nam (mapVals $ rulesets state)+        Nothing  -> getMaybeContextAxiom nam (nub $ M.elems $ rulesets state)         Just []  -> Just $ Formula nam emptyRDFGraph         Just grs -> Just $ Formula nam (head grs) @@ -161,8 +158,8 @@ -- | Find a named rule. findRule :: ScopedName -> SwishState -> Maybe RDFRule findRule nam state =-    case mapFindMaybe nam (rules state) of-      Nothing -> getMaybeContextRule nam $ mapVals $ rulesets state+    case M.lookup nam (rules state) of+      Nothing -> getMaybeContextRule nam $ nub $ M.elems $ rulesets state       justlr  -> justlr  -- | Modify the rule sets.@@ -173,7 +170,7 @@ -- | Find a rule set. findRuleset ::     ScopedName -> SwishState -> Maybe RDFRuleset-findRuleset nam state = mapFindMaybe (getScopeNamespace nam) (rulesets state)+findRuleset nam state = M.lookup (getScopeNamespace nam) (rulesets state)  -- | Find a modify rule. findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify@@ -208,6 +205,7 @@ 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. @@ -216,13 +214,10 @@     , ngGraph   :: [RDFGraph]     } -instance LookupEntryClass NamedGraph ScopedName [RDFGraph]-    where-        keyVal   (NamedGraph k v) = (k,v)-        newEntry (k,v)            = NamedGraph k v+-}  -- | A LookupMap for the graphs dictionary.-type NamedGraphMap = LookupMap NamedGraph+type NamedGraphMap = M.Map ScopedName [RDFGraph]  -- | Report error and set exit status code 

@@ -1,19 +1,17 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}  -------------------------------------------------------------------------------- --  See end of this file for licence information. -------------------------------------------------------------------------------- -- | --  Module      :  Namespace---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TypeSynonymInstances+--  Portability :  OverloadedStrings -- --  This module defines algebraic datatypes for namespaces and scoped names. --@@ -44,9 +42,9 @@  import Swish.QName (QName, LName, newQName, getLName, emptyLName, getQNameURI, getNamespace, getLocalName) -import Data.LookupMap (LookupEntryClass(..)) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..))+import Data.Ord (comparing) import Data.String (IsString(..))  import Network.URI (URI(..), parseURIReference, nullURI)@@ -62,6 +60,7 @@ --  data Namespace = Namespace (Maybe T.Text) URI+ -- data Namespace = Namespace (Maybe T.Text) !URI -- TODO: look at interning the URI                  @@ -83,14 +82,15 @@ instance Eq Namespace where   (Namespace _ u1) == (Namespace _ u2) = u1 == u2 +instance Ord Namespace where+    -- using show for the URI is wasteful+    (Namespace a1 b1) `compare` (Namespace a2 b2) =+        (a1, show b1) `compare` (a2, show b2)+ instance Show Namespace where     show (Namespace (Just p) u) = show p ++ ":<" ++ show u ++ ">"     show (Namespace _ u)        = "<" ++ show u ++ ">" -instance LookupEntryClass Namespace (Maybe T.Text) URI where-    keyVal   (Namespace pre uri) = (pre,uri)-    newEntry (pre,uri)           = Namespace pre uri- -- | Create a name space from a URI and an optional prefix label. makeNamespace ::      Maybe T.Text  -- ^ optional prefix.@@ -148,19 +148,19 @@ getScopeURI :: ScopedName -> URI getScopeURI = getNamespaceURI . getScopeNamespace --- | This is not total since it will fail if the input string is not a valid URI.+-- | This is not total since it will fail if the input string is not a valid 'URI'. instance IsString ScopedName where   fromString s =     maybe (error ("Unable to convert " ++ s ++ " into a ScopedName"))           makeURIScopedName (parseURIReference s)     --- | Scoped names are equal if their corresponding QNames are equal+-- | Scoped names are equal if their corresponding 'QName' values are equal. instance Eq ScopedName where-  (ScopedName qn1 _ _) == (ScopedName qn2 _ _) = qn1 == qn2+    sn1 == sn2 = getQName sn1 == getQName sn2 --- | Scoped names are ordered by their QNames+-- | Scoped names are ordered by their 'QName' components. instance Ord ScopedName where-  (ScopedName qn1 _ _) <= (ScopedName qn2 _ _) = qn1 <= qn2+    compare = comparing getQName  -- | If there is a namespace associated then the Show instance -- uses @prefix:local@, otherwise @<url>@.

@@ -28,12 +28,12 @@ import Swish.Rule (showsFormula, showsFormulae) import Swish.Ruleset (Ruleset(..)) -import Swish.Utils.ListHelpers (subset)- import Data.List (union, intersect, intercalate, foldl') import Data.Maybe (catMaybes, isNothing) import Data.String.ShowLines (ShowLines(..)) +import qualified Data.Set as S+ ------------------------------------------------------------ --  Proof framework ------------------------------------------------------------@@ -76,14 +76,18 @@  -- |Check consistency of given proof. --  The supplied rules and axioms are assumed to be correct.-checkProof :: (Expression ex) => Proof ex -> Bool+checkProof :: +    (Expression ex, Ord 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 :: +    (Expression ex, Ord ex) +    => [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool checkProof1 _     prev []       res = res `elem` prev checkProof1 rules prev (st:steps) res =     checkStep rules prev st &&@@ -98,7 +102,7 @@ --  being in correspondence with the name of one of the indicated --  valid rules of inference. checkStep :: -  (Expression ex) +  (Expression ex, Ord ex)    => [Rule ex]   -- ^ rules   -> [ex]        -- ^ antecedants   -> Step ex     -- ^ the step to validate@@ -148,7 +152,7 @@ -- |Check proof. If there is an error then return information -- about the failing step. explainProof ::-    (Expression ex) => Proof ex -> Maybe String+    (Expression ex, Ord ex) => Proof ex -> Maybe String explainProof pr =     explainProof1 (proofRules pr) initExpr (proofChain pr) goalExpr     where@@ -156,7 +160,8 @@         goalExpr = formExpr $ proofResult pr  explainProof1 ::-    (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String+    (Expression ex, Ord 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 =@@ -174,7 +179,7 @@ --  valid rules of inference. -- explainStep :: -  (Expression ex) +  (Expression ex, Ord ex)    => [Rule ex]  -- ^ rules   -> [ex]       -- ^ previous   -> Step ex    -- ^ step@@ -194,7 +199,7 @@             [ require (ruleName srul `elem` map ruleName rules)                       ("rule "++show (ruleName srul)++" not present")             -- Antecedent expressions are all previously accepted expressions-            , require (sant `subset` prev)+            , require (S.fromList sant `S.isSubsetOf` S.fromList prev) -- (sant `subset` prev)                       "antecedent not axiom or previous result"             -- Inference rule yields consequence from antecedents             , require (checkInference srul sant scon)

@@ -46,9 +46,11 @@ import Data.Maybe (fromMaybe) import Data.Interned (intern, unintern) import Data.Interned.URI (InternedURI)+import Data.Ord (comparing) import Data.String (IsString(..))  import Network.URI (URI(..), URIAuth(..), parseURIReference)+import Network.URI.Ord ()  import System.Directory (canonicalizePath) import System.FilePath (splitFileName)@@ -142,50 +144,25 @@ -- | Equality is determined by a case sensitive comparison of the                -- URI. instance Eq QName where-  -- see qnEq comments below-  (QName u1 _ _) == (QName u2 _ _) = u1 == u2---- ugly, use show instance OR switch to the ordering of InternedURI+    u1 == u2 = getQNameURI u1 == getQNameURI u2 --- | At present the ordering is based on a comparison of the @Show@--- instance of the URI.+-- | In @0.8.0.0@ the ordering now uses the ordering defined in+--   "Network.URI.Ord" rather than the @Show@+--   instance. This should make no difference unless a password+--   was included in the URI when using basic access authorization.+-- 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-  -}-  -  -- TODO: which is faster?-  -- Now we have changed to InternedURI, we could use the-  -- Ord instance of it, but it is unclear to me what the-  -- ordering means in that case, and whether the semantics-  -- matter here?-  (QName u1 _ _) <= (QName u2 _ _) = show u1 <= show u2-  -  {--  (QName _ uri1 l1) <= (QName _ uri2 l2) =-    if up1 /= up2 then up1 <= up2 else (ur1 ++ T.unpack l1) <= (ur2 ++ T.unpack l2)-      where-        u1 = show uri1-        u2 = show uri2-        -        n   = min (length u1) (length u2)-        (up1,ur1) = splitAt n u1-        (up2,ur2) = splitAt n u2-  -}+    compare = comparing getQNameURI   --- | The format used to display the URI is @\<uri\>@.+-- | The format used to display the URI is @\<uri\>@, and does not+--   include the password if using baccess access authorization. instance Show QName where     show (QName u _ _) = "<" ++ show u ++ ">"  {- The assumption in QName is that the validation done in creating the local name is sufficient to ensure that the combined -URI is syntactically valid. Is this in fact true?+URI is syntactically valid. Is this true? -}  -- | Create a new qualified name with an explicit local component.@@ -224,9 +201,8 @@ qnameFromURI uri =   let uf = uriFragment uri       up = uriPath uri-      q0 = Just $ QName iuri uri emptyLName-      start = QName iuri-      iuri = intern uri+      q0 = Just $ start uri emptyLName+      start = QName (intern uri)   in case uf of        "#"    -> q0        '#':xs -> start (uri {uriFragment = "#"}) `liftM` newLName (T.pack xs)@@ -254,25 +230,6 @@ -- namespace and local components). getQNameURI :: QName -> URI getQNameURI (QName u _ _) = unintern u--{--Original used comparison of concatenated strings,-but that was very inefficient.  The longer version below-does the comparison without constructing new values but is-no longer valid with the namespace being stored as a URI,-so for now just compare the overall URIs and we can-optimize this at a later date if needed.-qnEq :: QName -> QName -> Bool-qnEq (QName u1 _ _) (QName u2 _ _) = u1 == u2--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--}  {-| Convert a filepath to a file: URI stored in a QName. If the

@@ -3,12 +3,13 @@ -------------------------------------------------------------------------------- -- | --  Module      :  RDF---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances+--  Portability :  FlexibleInstances, MultiParamTypeClasses, OverloadedStrings -- --  This module provides an in-memory RDF Graph (it re-exports --  "Swish.RDF.Graph").

@@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- -- | --  Module      :  Datatypes---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke@@ -19,6 +20,7 @@        ( allDatatypes, findRDFDatatype )     where +import Swish.Datatype (typeName) import Swish.Namespace (ScopedName)  import Swish.RDF.Datatype (RDFDatatype)@@ -27,7 +29,7 @@ import Swish.RDF.Datatype.XSD.Integer (rdfDatatypeXsdInteger) import Swish.RDF.Datatype.XSD.Decimal (rdfDatatypeXsdDecimal) -import Data.LookupMap (LookupMap(..), mapFindMaybe)+import qualified Data.Map as M  ------------------------------------------------------------ --  Declare datatype map@@ -43,7 +45,8 @@  -- | Look up a data type declaration. findRDFDatatype :: ScopedName -> Maybe RDFDatatype-findRDFDatatype nam = mapFindMaybe nam (LookupMap allDatatypes)+findRDFDatatype nam = M.lookup nam $+                      M.fromList $ map (\dt -> (typeName dt, dt)) allDatatypes  ------------------------------------------------------------ --  Declare datatype subtypes map

@@ -25,7 +25,8 @@  import Swish.Datatype (typeRules, typeMkModifiers) import Swish.Namespace (ScopedName)-import Swish.VarBinding (nullVarBindingModify, makeVarFilterModify, varFilterEQ, varFilterNE)+import Swish.Ruleset (getRulesetNamespace)+import Swish.VarBinding (openVbmName, nullVarBindingModify, makeVarFilterModify, varFilterEQ, varFilterNE)  import Swish.RDF.BuiltIn.Datatypes (allDatatypes) import Swish.RDF.Ruleset (RDFRuleset, RDFRulesetMap)@@ -40,7 +41,7 @@     , rdfVarBindingMemberProp     ) -import Data.LookupMap (LookupMap(..), mapFindMaybe)+import qualified Data.Map as M  ------------------------------------------------------------ --  Declare variable binding filters list@@ -104,7 +105,8 @@ -- | Find the named open variable binding modifier. findRDFOpenVarBindingModifier :: ScopedName -> Maybe RDFOpenVarBindingModify findRDFOpenVarBindingModifier nam =-    mapFindMaybe nam (LookupMap allOpenVarBindingModify)+    M.lookup nam $ M.fromList $ map (\ovbm -> (openVbmName ovbm, ovbm))+                                allOpenVarBindingModify  ------------------------------------------------------------ --  Lookup map for built-in rulesets@@ -112,7 +114,7 @@  -- | A 'LookupMap' of 'allRulesets'. rdfRulesetMap :: RDFRulesetMap-rdfRulesetMap = LookupMap allRulesets+rdfRulesetMap = M.fromList $ map (\r -> (getRulesetNamespace r, r)) allRulesets  -- | All the rule sets known to Swish. allRulesets :: [RDFRuleset]

@@ -1,4 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}  --------------------------------------------------------------------------------@@ -6,12 +5,13 @@ -------------------------------------------------------------------------------- -- | --  Module      :  ClassRestrictionRule---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  MultiParamTypeClasses, OverloadedStrings+--  Portability :  OverloadedStrings -- --  This module implements an inference rule based on a restruction on class --  membership of one or more values.@@ -58,12 +58,13 @@  import Control.Monad (liftM) -import Data.List (delete, nub, (\\), subsequences)-import Data.LookupMap (LookupEntryClass(..), LookupMap(..),mapFindMaybe)+import Data.List (delete, nub, subsequences) import Data.Maybe (fromJust, fromMaybe, mapMaybe) import Data.Monoid (Monoid (..)) import Data.Ord.Partial (minima, maxima, partCompareEq, partComparePair, partCompareListMaybe, partCompareListSubset) +import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as B  ------------------------------------------------------------@@ -87,11 +88,6 @@ 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 ------------------------------------------------------------@@ -175,8 +171,10 @@         cs = filter (>0) $ map fromInteger $              rdfFindPredInt c resRdfdMaxCardinality gr         ps = rdfFindList gr p-        rn = mapFindMaybe (getScopedName r) (LookupMap crs) +        -- TODO: do not need to go via a map since looking through a list+        rn = M.lookup (getScopedName r) $ M.fromList $ map (\cr -> (crName cr, cr)) crs+ makeRestrictionRule2 ::     Maybe ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int]     -> Maybe RDFRule@@ -229,9 +227,9 @@         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]+        newarcs = S.fromList [Arc ci p v | vs <- nts, (p,v) <- zip props vs ]+                  `S.difference` getArcs antgr+        newgrs  = if S.null newarcs then [] else [toRDFGraph newarcs]  --  Backward apply class restriction. --@@ -289,11 +287,14 @@         --  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 resRdfType cls :)+        --  TODO: convert to sets+        makeGraphs = map (toRDFGraph . S.fromList . (:[])) . (Arc ci resRdfType cls :)  --  Helper function to select sub-tuples from which some of a set of --  values can be derived using a class restriction.

@@ -0,0 +1,253 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  Internal+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  CPP, OverloadedStrings+--+--  Utility routines.+--+--------------------------------------------------------------------------------++module Swish.RDF.Formatter.Internal+    ( NodeGenLookupMap+    , SubjTree+    , PredTree+    , LabelContext(..)+    , NodeGenState(..)+    , emptyNgs +    , findMaxBnode+    , getCollection+    , processArcs+    , findPrefix+    )+where++import Swish.GraphClass (Arc(..), ArcSet)+import Swish.RDF.Graph (RDFGraph, RDFLabel(..), NamespaceMap)+import Swish.RDF.Graph (labels, getArcs, resRdfFirst, resRdfRest, resRdfNil)++import Data.List (delete, foldl', groupBy)+import Data.Word++import Network.URI (URI)+import Network.URI.Ord ()++import qualified Data.Map as M+import qualified Data.Set as S++#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 701)+import Data.Tuple (swap)+#else+swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+#endif++findPrefix :: URI -> M.Map a URI -> Maybe a+findPrefix u = M.lookup u . M.fromList . map swap . M.assocs++-- | Node name generation state information that carries through+--  and is updated by nested formulae.+type NodeGenLookupMap = M.Map RDFLabel Word32++type SubjTree lb = [(lb,PredTree lb)]+type PredTree lb = [(lb,[lb])]++-- simple context for label creation+-- (may be a temporary solution to the problem+--  of label creation)+--+data LabelContext = SubjContext | PredContext | ObjContext+                    deriving (Eq, Show)++data NodeGenState = Ngs+    { prefixes  :: NamespaceMap+    , nodeMap   :: NodeGenLookupMap+    , nodeGen   :: Word32+    }++emptyNgs :: NodeGenState+emptyNgs = Ngs+    { prefixes  = M.empty+    , nodeMap   = M.empty+    , nodeGen   = 0+    }++{-|+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++{-|+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 rdfRest 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 == resRdfNil = Just (sl, reverse cs, ss)+                      | otherwise = do+        (pList1, sl') <- removeItem sl l+        ([pFirst], pList2) <- removeItem pList1 resRdfFirst+        ([pNext], []) <- removeItem pList2 resRdfRest++        go sl' pNext (pFirst : cs, l : ss)++----------------------------------------------------------------------+--  Graph-related helper functions+----------------------------------------------------------------------++processArcs :: RDFGraph -> (SubjTree RDFLabel, [RDFLabel])+processArcs gr =+    let arcs = sortArcs $ getArcs gr+    in (arcTree arcs, countBnodes arcs)++newtype SortedArcs lb = SA [Arc lb]++sortArcs :: (Ord lb) => ArcSet lb -> SortedArcs lb+sortArcs = SA . S.toAscList++--  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 -> Word32+findMaxBnode = S.findMax . S.map getAutoBnodeIndex . labels++getAutoBnodeIndex   :: RDFLabel -> Word32+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, 2012 Douglas Burke+--  All rights reserved.+--+--  This file is part of Swish.+--+--  Swish is free software; you can redistribute it and/or modify+--  it under the terms of the GNU General Public License as published by+--  the Free Software Foundation; either version 2 of the License, or+--  (at your option) any later version.+--+--  Swish is distributed in the hope that it will be useful,+--  but WITHOUT ANY WARRANTY; without even the implied warranty of+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+--  GNU General Public License for more details.+--+--  You should have received a copy of the GNU General Public License+--  along with Swish; if not, write to:+--    The Free Software Foundation, Inc.,+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA+--+--------------------------------------------------------------------------------

@@ -5,7 +5,8 @@ -------------------------------------------------------------------------------- -- | --  Module      :  N3---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke@@ -59,22 +60,28 @@     ) where -import Swish.GraphClass (Arc(..))+import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree+                                    , LabelContext(..)+                                    , NodeGenState(..), emptyNgs+                                    , findMaxBnode+                                    , getCollection+                                    , processArcs+				    , findPrefix) + import Swish.Namespace (ScopedName, getScopeLocal, getScopeURI) import Swish.QName (getLName)  import Swish.RDF.Graph (   RDFGraph, RDFLabel(..),-  NamespaceMap, RevNamespaceMap,+  NamespaceMap,   emptyNamespaceMap,   FormulaMap, emptyFormulaMap,-  getArcs, labels,   setNamespaces, getNamespaces,   getFormulae,   emptyRDFGraph   , quote   , quoteT-  , resRdfFirst, resRdfRest, resRdfNil+  , resRdfFirst, resRdfRest   )  import Swish.RDF.Vocabulary (@@ -89,10 +96,7 @@ import Control.Monad.State (State, modify, get, put, runState)  import Data.Char (isDigit)-import Data.List (foldl', delete, groupBy, partition, sort, intersperse)-import Data.LookupMap (LookupEntryClass(..), LookupMap)-import Data.LookupMap (emptyLookupMap, reverseLookupMap, listLookupMap-                      , mapFind, mapFindMaybe, mapAdd, mapDelete, mapMerge)+import Data.List (partition, intersperse) import Data.Monoid (Monoid(..)) import Data.Word (Word32) @@ -100,6 +104,7 @@ -- wrong; however I have done no profiling to back this -- assumption up! +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -118,9 +123,6 @@ --  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    :: B.Builder     , lineBreak :: Bool@@ -152,30 +154,6 @@     , traceBuf  = []     } --- | Node name generation state information that carries through--- and is updated by nested formulae.-type NodeGenLookupMap = LookupMap (RDFLabel, Word32)--data NodeGenState = Ngs-    { prefixes  :: NamespaceMap-    , nodeMap   :: NodeGenLookupMap-    , nodeGen   :: Word32-    }--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 B.Builder getIndent = indent `liftM` get @@ -233,13 +211,13 @@ 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+      _newState fv = st {+                       formAvail = M.delete fn fa,+                       formQueue = (fn,fv) : formQueue st+                     }+  case M.lookup fn fa of     Nothing -> return ()-    Just v -> void $ put $ newState v+    Just v -> void $ put $ _newState v  {- Return the graph associated with the label and delete it@@ -249,11 +227,9 @@ 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)+  let (rval, nform) = M.updateLookupWithKey (\_ _ -> Nothing) fn $ formAvail st+  put $ st { formAvail = nform }+  return rval  {- moreFormulae :: Formatter Bool@@ -270,49 +246,6 @@  -} --- 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 rdfRest 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 == resRdfNil = Just (sl, reverse cs, ss)-                      | otherwise = do-        (pList1, sl') <- removeItem sl l-        (pFirst, pList2) <- removeItem pList1 resRdfFirst-        (pNext, pList3) <- removeItem pList2 resRdfRest--        -- 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: @@ -344,18 +277,6 @@      Nothing -> return Nothing   -{-|-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: ----------------------------------------------------------------------@@ -391,7 +312,7 @@ formatGraphDiag indnt flag gr =    let fg  = formatGraph indnt " .\n" False flag gr       ngs = emptyNgs {-        prefixes = emptyLookupMap,+        prefixes = M.empty,         nodeGen  = findMaxBnode gr         }              @@ -428,7 +349,7 @@  formatPrefixes :: NamespaceMap -> Formatter B.Builder formatPrefixes pmap = do-  let mls = map (pref . keyVal) (listLookupMap pmap)+  let mls = map pref $ M.assocs pmap   ls <- sequence mls   return $ mconcat ls     where@@ -596,39 +517,36 @@ --  Formatting helpers ---------------------------------------------------------------------- -setGraph :: RDFGraph -> Formatter ()-setGraph gr = do-  st <- get+newState :: RDFGraph -> N3FormatterState -> N3FormatterState+newState gr st = +    let ngs0 = nodeGenSt st+        pre' = prefixes ngs0 `M.union` getNamespaces gr+        ngs' = ngs0 { prefixes = pre' }+        (arcSubjs, bNodes) = processArcs gr -  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-                 }+    in st  { graph     = gr+           , subjs     = arcSubjs+           , props     = []+           , objs      = []+           , formAvail = getFormulae gr+           , nodeGenSt = ngs'+           , bNodesCheck   = bNodes+           } -  put nst+setGraph :: RDFGraph -> Formatter ()+setGraph = modify . newState  hasMore :: (N3FormatterState -> [b]) -> Formatter Bool hasMore lens = (not . null . lens) `liftM` get  moreSubjects :: Formatter Bool moreSubjects = hasMore subjs--- moreSubjects = (not . null . subjs) `liftM` get  moreProperties :: Formatter Bool moreProperties = hasMore props--- moreProperties = (not . null . props) `liftM` get  moreObjects :: Formatter Bool moreObjects = hasMore objs--- moreObjects = (not . null . objs) `liftM` get  nextSubject :: Formatter RDFLabel nextSubject = do@@ -737,8 +655,7 @@       pr <- getPrefixes       let nsuri  = getScopeURI sn           local  = getLName $ getScopeLocal sn-          premap = reverseLookupMap pr :: RevNamespaceMap-          prefix = mapFindMaybe nsuri premap+	  prefix = findPrefix nsuri pr                      name   = case prefix of                      Just (Just p) -> B.fromText $ quoteT True $ mconcat [p, ":", local] -- TODO: what are quoting rules for QNames@@ -798,10 +715,10 @@   ngs <- getNgs   let cmap = nodeMap ngs       cval = nodeGen ngs-  nv <- case mapFind 0 lab cmap of+  nv <- case M.findWithDefault 0 lab cmap of     0 -> do        let nval = succ cval-          nmap = mapAdd cmap (lab, nval)+          nmap = M.insert lab nval cmap       setNgs $ ngs { nodeGen = nval, nodeMap = nmap }       return nval       @@ -820,102 +737,6 @@   in quote uri -} showScopedName = quoteB 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 -> Word32-findMaxBnode = maximum . map getAutoBnodeIndex . labels--getAutoBnodeIndex   :: RDFLabel -> Word32-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  -------------------------------------------------------------------------------- --

@@ -4,7 +4,8 @@ -------------------------------------------------------------------------------- -- | --  Module      :  NTriples---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke@@ -28,6 +29,8 @@     ) where +import Swish.RDF.Formatter.Internal (NodeGenLookupMap)+ import Swish.GraphClass (Arc(..)) import Swish.Namespace (ScopedName, getQName) @@ -40,13 +43,15 @@ import Control.Applicative ((<$>))  import Data.Char (ord, intToDigit, toUpper)-import Data.LookupMap (LookupMap, emptyLookupMap, mapFind, mapAdd) import Data.Monoid+import Data.Word (Word32)  -- it strikes me that using Lazy Text here is likely to be -- wrong; however I have done no profiling to back this -- assumption up! +import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -57,18 +62,14 @@ -- --  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+      ntfsNodeGen :: Word32     } deriving Show  emptyNTFS :: NTFormatterState emptyNTFS = NTFS {-              ntfsNodeMap = emptyLookupMap,+              ntfsNodeMap = M.empty,               ntfsNodeGen = 0               } @@ -91,7 +92,7 @@ ----------------------------------------------------------------------  formatGraph :: RDFGraph -> Formatter B.Builder-formatGraph gr = mconcat <$> mapM formatArc (getArcs gr)+formatGraph gr = mconcat <$> mapM formatArc (S.toList (getArcs gr))  -- TODO: this reverses the contents but may be faster? --       that is if I've got the order right in the mappend call@@ -146,10 +147,10 @@   let cmap = ntfsNodeMap st       cval = ntfsNodeGen st -  nv <- case mapFind 0 lab cmap of+  nv <- case M.findWithDefault 0 lab cmap of             0 -> do               let nval = succ cval-                  nmap = mapAdd cmap (lab, nval)+                  nmap = M.insert lab nval cmap                put $ st { ntfsNodeMap = nmap, ntfsNodeGen = nval }               return nval

@@ -5,7 +5,8 @@ -------------------------------------------------------------------------------- -- | --  Module      :  Turtle---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke@@ -45,24 +46,25 @@     ) where -import Swish.GraphClass (Arc(..))+import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree+                                    , LabelContext(..)+                                    , NodeGenState(..), emptyNgs+                                    , findMaxBnode+                                    , getCollection+                                    , processArcs+				    , findPrefix)+ import Swish.Namespace (ScopedName, getScopeLocal, getScopeURI) import Swish.QName (getLName)  import Swish.RDF.Graph (   RDFGraph, RDFLabel(..)-  , NamespaceMap, RevNamespaceMap-  -- emptyNamespaceMap,-  -- FormulaMap, emptyFormulaMap,-  , getArcs-  , labels-  -- , setNamespaces-  , getNamespaces,-  -- getFormulae,-  emptyRDFGraph+  , NamespaceMap+  , getNamespaces+  , emptyRDFGraph   , quote   , quoteT-  , resRdfFirst, resRdfRest, resRdfNil+  , resRdfFirst, resRdfRest   )  import Swish.RDF.Vocabulary ( fromLangTag @@ -75,9 +77,7 @@ import Control.Monad.State (State, modify, get, put, runState)  import Data.Char (isDigit)-import Data.List (foldl', delete, groupBy, partition, sort, intersperse)-import Data.LookupMap (LookupEntryClass(..), LookupMap)-import Data.LookupMap (emptyLookupMap, reverseLookupMap, listLookupMap, mapFind, mapFindMaybe, mapAdd, mapMerge)+import Data.List (partition, intersperse) import Data.Monoid (Monoid(..)) import Data.Word (Word32) @@ -85,6 +85,7 @@ -- wrong; however I have done no profiling to back this -- assumption up! +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -103,9 +104,6 @@ --  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 TurtleFormatterState = TFS     { indent    :: B.Builder     , lineBreak :: Bool@@ -137,29 +135,6 @@     , traceBuf  = []     } --- | Node name generation state information.-type NodeGenLookupMap = LookupMap (RDFLabel, Word32)--data NodeGenState = Ngs-    { prefixes  :: NamespaceMap-    , nodeMap   :: NodeGenLookupMap-    , nodeGen   :: Word32-    }--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 B.Builder getIndent = indent `liftM` get @@ -214,94 +189,6 @@ -}    {--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 rdfRest 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 == resRdfNil = Just (sl, reverse cs, ss)-                      | otherwise = do-        (pList1, sl') <- removeItem sl l-        (pFirst, pList2) <- removeItem pList1 resRdfFirst-        (pNext, pList3) <- removeItem pList2 resRdfRest--        -- 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?@@ -332,18 +219,6 @@      Nothing -> return Nothing   -{-|-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: ----------------------------------------------------------------------@@ -379,7 +254,7 @@ formatGraphDiag indnt flag gr =    let fg  = formatGraph indnt " .\n" False flag gr       ngs = emptyNgs {-        prefixes = emptyLookupMap,+        prefixes = M.empty,         nodeGen  = findMaxBnode gr         }              @@ -416,7 +291,7 @@  formatPrefixes :: NamespaceMap -> Formatter B.Builder formatPrefixes pmap = do-  let mls = map (pref . keyVal) (listLookupMap pmap)+  let mls = map pref $ M.assocs pmap   ls <- sequence mls   return $ mconcat ls     where@@ -571,39 +446,35 @@ --  Formatting helpers ---------------------------------------------------------------------- -setGraph :: RDFGraph -> Formatter ()-setGraph gr = do-  st <- get+newState :: RDFGraph -> TurtleFormatterState -> TurtleFormatterState+newState gr st = +    let ngs0 = nodeGenSt st+        pre' = prefixes ngs0 `M.union` getNamespaces gr+        ngs' = ngs0 { prefixes = pre' }+        (arcSubjs, bNodes) = processArcs gr -  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-                 }+    in st  { graph     = gr+           , subjs     = arcSubjs+           , props     = []+           , objs      = []+           , nodeGenSt = ngs'+           , bNodesCheck   = bNodes+           } -  put nst+setGraph :: RDFGraph -> Formatter ()+setGraph = modify . newState  hasMore :: (TurtleFormatterState -> [b]) -> Formatter Bool hasMore lens = (not . null . lens) `liftM` get  moreSubjects :: Formatter Bool moreSubjects = hasMore subjs--- moreSubjects = (not . null . subjs) `liftM` get  moreProperties :: Formatter Bool moreProperties = hasMore props--- moreProperties = (not . null . props) `liftM` get  moreObjects :: Formatter Bool moreObjects = hasMore objs--- moreObjects = (not . null . objs) `liftM` get  nextSubject :: Formatter RDFLabel nextSubject = do@@ -701,10 +572,7 @@   pr <- getPrefixes   let nsuri  = getScopeURI sn       local  = getLName $ getScopeLocal sn-      premap = reverseLookupMap pr :: RevNamespaceMap-      prefix = mapFindMaybe nsuri premap-          -      name   = case prefix of+      name   = case findPrefix nsuri pr of         Just (Just p) -> B.fromText $ quoteT True $ mconcat [p, ":", local] -- TODO: what are quoting rules for QNames         _ -> mconcat ["<", quoteB True (show nsuri ++ T.unpack local), ">"]       @@ -748,10 +616,10 @@   ngs <- getNgs   let cmap = nodeMap ngs       cval = nodeGen ngs-  nv <- case mapFind 0 lab cmap of+  nv <- case M.findWithDefault 0 lab cmap of     0 -> do        let nval = succ cval-          nmap = mapAdd cmap (lab, nval)+          nmap = M.insert lab nval cmap       setNgs $ ngs { nodeGen = nval, nodeMap = nmap }       return nval       @@ -770,86 +638,6 @@   in quote uri -} showScopedName = quoteB 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--findMaxBnode :: RDFGraph -> Word32-findMaxBnode = maximum . map getAutoBnodeIndex . labels--getAutoBnodeIndex   :: RDFLabel -> Word32-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  -------------------------------------------------------------------------------- --

@@ -1,7 +1,5 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE OverloadedStrings #-}  --------------------------------------------------------------------------------@@ -9,12 +7,13 @@ -------------------------------------------------------------------------------- -- | --  Module      :  Graph---  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,+--                 2011, 2012 Douglas Burke --  License     :  GPL V2 -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  CPP, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, OverloadedStrings+--  Portability :  FlexibleInstances, MultiParamTypeClasses, OverloadedStrings -- --  This module defines a memory-based RDF graph instance. --@@ -35,12 +34,13 @@     , quoteT              -- * RDF Graphs+    , RDFArcSet     , RDFTriple     , toRDFTriple, fromRDFTriple     , NSGraph(..)     , RDFGraph     , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}-    , NamespaceMap, RevNamespaceMap, RevNamespace+    , NamespaceMap     , emptyNamespaceMap     , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap     , addArc, merge@@ -48,6 +48,8 @@     , newNode, newNodes     , setNamespaces, getNamespaces     , setFormulae, getFormulae, setFormula, getFormula+    , fmapNSGraph+    , traverseNSGraph            -- * Re-export from GraphClass     --@@ -151,7 +153,7 @@     where  import Swish.Namespace-    ( Namespace, makeNamespace, getNamespaceTuple+    ( getNamespaceTuple     , getScopedNameURI     , ScopedName     , getScopeLocal, getScopeNamespace@@ -161,28 +163,29 @@     , nullScopedName     ) -import Swish.RDF.Vocabulary-{-    -    ( namespaceRDF-    , langTag, isLang-    , rdfType-    , rdfFirst, rdfRest, rdfNil, rdfXMLLiteral-    , rdfsMember-    , rdfdGeneralRestriction-    , rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality-    , owlSameAs, logImplies-    , xsdBoolean, xsdDecimal, xsdFloat, xsdDouble, xsdInteger-    , xsdDateTime, xsdDate                                                -    )--}+import Swish.RDF.Vocabulary (LanguageTag)+import Swish.RDF.Vocabulary (fromLangTag, xsdBoolean, xsdDate, xsdDateTime, xsdDecimal, xsdDouble, xsdFloat, xsdInteger+                            , rdfType, rdfList, rdfFirst, rdfRest, rdfNil+                            , rdfsMember, rdfdGeneralRestriction, rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality+                            , rdfsSeeAlso, rdfValue, rdfsLabel, rdfsComment, rdfProperty+                            , rdfsSubPropertyOf, rdfsSubClassOf, rdfsClass, rdfsLiteral+                            , rdfsDatatype, rdfXMLLiteral, rdfsRange, rdfsDomain, rdfsContainer+                            , rdfBag, rdfSeq, rdfAlt+                            , rdfsContainerMembershipProperty, rdfsIsDefinedBy+                            , rdfsResource, rdfStatement, rdfSubject, rdfPredicate, rdfObject+                            , rdfRDF, rdfDescription, rdfID, rdfAbout, rdfParseType+                            , rdfResource, rdfLi, rdfNodeID, rdfDatatype, rdfXMLLiteral+                            , rdf1, rdf2, rdfn+                            , owlSameAs, logImplies, namespaceRDF+                            ) -import Swish.GraphClass (LDGraph(..), Label (..), Arc(..), Selector)-import Swish.GraphClass (arc, arcLabels)+import Swish.GraphClass (LDGraph(..), Label (..), Arc(..), ArcSet, Selector)+import Swish.GraphClass (arc, arcLabels, getComponents) import Swish.GraphMatch (LabelMap, ScopedLabel(..)) import Swish.GraphMatch (graphMatch) import Swish.QName (QName, getLName) -import Control.Applicative (Applicative, liftA, (<$>), (<*>))+import Control.Applicative (Applicative(pure), (<$>), (<*>))  import Network.URI (URI) @@ -191,9 +194,7 @@ import Data.Char (ord, isDigit) import Data.Hashable (hashWithSalt) import Data.List (intersect, union, foldl')-import Data.LookupMap (LookupMap(..), LookupEntryClass(..))-import Data.LookupMap (listLookupMap, mapFind, mapFindMaybe, mapReplace, mapAddIfNew, mapVals, mapKeys )-import Data.Ord (comparing)+-- import Data.Ord (comparing) import Data.Word (Word32)  import Data.String (IsString(..))@@ -203,22 +204,11 @@  import Text.Printf -import qualified Data.Foldable as Foldable-import qualified Data.Traversable as Traversable-+import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Read as T--- import qualified Data.Text.Lazy as L--- import Data.Text.Format (format)--- import Data.Text.Buildable--- import Data.Text.Format.Types (Only(..))--#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 701)-import Data.Tuple (swap)-#else-swap :: (a,b) -> (b,a)-swap (a,b) = (b,a)-#endif+import qualified Data.Traversable as Traversable  -- | RDF graph node values --@@ -290,26 +280,35 @@     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+    -- Order, from lowest to highest is+    --    Res, Lit, LangLit, TypedLit, Blank, Var, NoNode+    --+    compare (Res sn1)        (Res sn2)        = compare sn1 sn2+    compare (Res _)          _                = LT+    compare _                (Res _)          = GT -    compare (Lit s1)       (Lit s2)       = compare s1 s2+    compare (Lit s1)         (Lit s2)         = compare s1 s2+    compare (Lit _)          _                = LT+    compare _                (Lit _)          = GT -    -- .. else use show string comparison-    compare l1 l2 = comparing show l1 l2-    -    {- <= is not used if compare is provided-    -- 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-    -}-    +    compare (LangLit s1 l1)  (LangLit s2 l2)  = compare (s1,l1) (s2,l2)+    compare (LangLit _ _)    _                = LT+    compare _                (LangLit _ _)    = GT++    compare (TypedLit s1 t1) (TypedLit s2 t2) = compare (s1,t1) (s2,t2)+    compare (TypedLit _ _)   _                = LT+    compare _                (TypedLit _ _)   = GT++    compare (Blank ln1)      (Blank ln2)      = compare ln1 ln2+    compare (Blank _)        _                = LT+    compare _                (Blank _)        = GT++    compare (Var ln1)        (Var ln2)        = compare ln1 ln2+    compare (Var _)          NoNode           = LT+    compare _                (Var _)          = GT++    compare NoNode           NoNode           = EQ+ instance Label RDFLabel where     labelIsVar (Blank _)    = True     labelIsVar (Var _)      = True@@ -1002,6 +1001,9 @@ -- type RDFTriple = Arc RDFLabel +-- | A set of RDF triples.+type RDFArcSet = ArcSet RDFLabel+ -- | Convert 3 RDF labels to a RDF triple. -- --   See also @Swish.RDF.GraphClass.arcFromTriple@.@@ -1028,22 +1030,12 @@    -- | Namespace prefix list entry --- | A 'LookupMap' for name spaces.-type NamespaceMap = LookupMap Namespace---- | A 'LookupMap' for reversed name spaces.-type RevNamespaceMap = LookupMap RevNamespace---- | Support for reversed name spaces in a 'LookupMap'.-data RevNamespace = RevNamespace Namespace--instance LookupEntryClass RevNamespace URI (Maybe T.Text) where-    keyVal   (RevNamespace ns) = swap $ getNamespaceTuple ns-    newEntry (uri,pre) = RevNamespace (makeNamespace pre uri)+-- | A map for name spaces (key is the prefix).+type NamespaceMap = M.Map (Maybe T.Text) URI -- TODO: should val be URI or namespace?  -- | Create an empty namespace map. emptyNamespaceMap :: NamespaceMap-emptyNamespaceMap = LookupMap []+emptyNamespaceMap = M.empty  -- | Graph formula entry @@ -1056,50 +1048,63 @@     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 ++ " }"+instance (Ord lb, Ord gr) => Ord (LookupFormula lb gr) where+    (Formula a1 b1) `compare` (Formula a2 b2) =+        (a1,b1) `compare` (a2,b2)  -- | A named formula. type Formula lb = LookupFormula lb (NSGraph lb) --- | A 'LookupMap' for named formulae.-type FormulaMap lb = LookupMap (LookupFormula lb (NSGraph lb))+instance (Label lb) => Show (Formula lb)+    where+        show (Formula l g) = show l ++ " :- { " ++ showArcs "    " g ++ " }" +-- | A map for named formulae.+type FormulaMap lb = M.Map lb (NSGraph lb)+ -- | Create an empty formula map. emptyFormulaMap :: FormulaMap RDFLabel-emptyFormulaMap = LookupMap []+emptyFormulaMap = M.empty -{-  given up on trying to do Functor for formulae...-instance Functor (LookupFormula (NSGraph lb)) where-    fmap f fm = mapTranslateEntries (mapFormulaEntry f) fm+-- fmapFormulaMap :: (Ord a, Ord b) => (a -> b) -> FormulaMap a -> FormulaMap b+fmapFormulaMap :: (Ord a) => (a -> a) -> FormulaMap a -> FormulaMap a+fmapFormulaMap f m = M.fromList $ map (\(k,g) -> (f k, fmapNSGraph f g)) $ M.assocs m++-- TODO: how to traverse formulamaps now?++{-+traverseFormulaMap :: +    (Applicative f, Ord a, Ord b) +    => (a -> f b) -> FormulaMap a -> f (FormulaMap b) -}+traverseFormulaMap :: +    (Applicative f, Ord a) +    => (a -> f a) -> FormulaMap a -> f (FormulaMap a)+traverseFormulaMap f = Traversable.traverse (traverseFormula f) -formulaeMap :: (lb -> l2) -> FormulaMap lb -> FormulaMap l2-formulaeMap f = fmap (formulaEntryMap f) +{-+traverseFormula :: +    (Applicative f, Ord a, Ord b)+    => (a -> f b) -> Formula a -> f (Formula b)+-}+{-+traverseFormula :: +    (Applicative f, Ord a)+    => (a -> f a) -> Formula a -> f (Formula a)+traverseFormula f (Formula k gr) = Formula <$> f k <*> traverseNSGraph f gr+-} -formulaEntryMap ::-    (lb -> l2)-    -> Formula lb-    -> Formula l2-formulaEntryMap f (Formula k gr) = Formula (f k) (fmap f gr)+traverseFormula ::+    (Applicative f, Ord a)+    => (a -> f a) -> NSGraph a -> f (NSGraph a) -formulaeMapA :: Applicative f => (lb -> f l2) -> -                FormulaMap lb -> f (FormulaMap l2)-formulaeMapA f = Traversable.traverse (formulaEntryMapA f)+{-+traverseFormula ::+    (Applicative f, Ord a, Ord b)+    => (a -> f b) -> NSGraph a -> f (NSGraph b)+-} -formulaEntryMapA ::-  (Applicative f) => -  (lb -> f l2)-  -> Formula lb-  -> f (Formula l2)-formulaEntryMapA f (Formula k gr) = Formula `liftA` f k <*> Traversable.traverse f gr+traverseFormula = traverseNSGraph  {- formulaeMapM ::@@ -1133,13 +1138,14 @@  -} data NSGraph lb = NSGraph-    { namespaces :: NamespaceMap    -- ^ the namespaces to use-    , formulae   :: FormulaMap lb   -- ^ any associated formulae (a.k.a. sub- or named- graps)-    , statements :: [Arc lb]        -- ^ the statements in the graph+    { namespaces :: NamespaceMap      -- ^ the namespaces to use+    , formulae   :: FormulaMap lb     -- ^ any associated formulae +                                      --   (a.k.a. sub- or named- graps)+    , statements :: ArcSet lb         -- ^ the statements in the graph     }  instance (Label lb) => LDGraph NSGraph lb where-    emptyGraph   = NSGraph emptyNamespaceMap (LookupMap []) []+    emptyGraph   = NSGraph emptyNamespaceMap M.empty S.empty     getArcs      = statements      setArcs g as = g { statements=as } @@ -1148,20 +1154,42 @@     mempty  = emptyGraph     mappend = merge   -instance Functor NSGraph where-  fmap f (NSGraph ns fml stmts) =-    NSGraph ns (formulaeMap f fml) ((map $ fmap f) stmts)+-- | 'fmap' for 'NSGraph' instances.+-- fmapNSGraph :: (Ord lb1, Ord lb2) => (lb1 -> lb2) -> NSGraph lb1 -> NSGraph lb2+fmapNSGraph :: (Ord lb) => (lb -> lb) -> NSGraph lb -> NSGraph lb+fmapNSGraph f (NSGraph ns fml stmts) = +    NSGraph ns (fmapFormulaMap f fml) ((S.map $ fmap f) stmts) -instance Foldable.Foldable NSGraph where-  foldMap = Traversable.foldMapDefault+-- | 'Data.Traversable.traverse' for 'NSGraph' instances.+{-+traverseNSGraph :: +    (Applicative f, Ord a, Ord b) +    => (a -> f b) -> NSGraph a -> f (NSGraph b)+-}+traverseNSGraph :: +    (Applicative f, Ord a) +    => (a -> f a) -> NSGraph a -> f (NSGraph a)+traverseNSGraph f (NSGraph ns fml stmts) = +    NSGraph ns <$> traverseFormulaMap f fml <*> (traverseSet $ Traversable.traverse f) stmts -instance Traversable.Traversable NSGraph where-  traverse f (NSGraph ns fml stmts) = -    NSGraph ns <$> formulaeMapA f fml <*> (Traversable.traverse $ Traversable.traverse f) stmts-  +traverseSet ::+    (Applicative f, Ord a, Ord b)+    => (a -> f b) -> S.Set a -> f (S.Set b)+traverseSet f = S.foldr cons (pure S.empty)+    where+      cons x s = S.insert <$> f x <*> s+ instance (Label lb) => Eq (NSGraph lb) where     (==) = grEq +-- The namespaces are not used in the ordering since this could+-- lead to identical graphs not being considered the same when+-- ordering.+--+instance (Label lb) => Ord (NSGraph lb) where+    (NSGraph _ fml1 stmts1) `compare` (NSGraph _ fml2 stmts2) =+        (fml1,stmts1) `compare` (fml2,stmts2)+ instance (Label lb) => Show (NSGraph lb) where     show     = grShow ""     showList = grShowList ""@@ -1184,11 +1212,13 @@  -- | Find a formula in the graph, if it exists. getFormula     :: (Label lb) => NSGraph lb -> lb -> Maybe (NSGraph lb)-getFormula g l = mapFindMaybe l (formulae g)+-- getFormula g l = fmap formGraph $ M.lookup l (formulae g)+getFormula g l = M.lookup l (formulae g)  -- | Add (or replace) a formula. setFormula     :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb-setFormula f g = g { formulae=mapReplace (formulae g) f }+-- setFormula f g = g { formulae = M.insert (formLabel f) f (formulae g) }+setFormula (Formula fn fg) g = g { formulae = M.insert fn fg (formulae g) }  {-| Add an arc to the graph. It does not relabel any blank nodes in the input arc,@@ -1196,12 +1226,7 @@ but it does ensure that the arc is unknown before adding it. -} addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb-addArc ar gr = gr { statements=addSetElem ar (statements gr) }---- |Add element to the set.--addSetElem :: (Eq a) => a -> [a] -> [a]-addSetElem e es = if e `elem` es then es else e:es+addArc ar = update (S.insert ar)  grShowList :: (Label lb) => String -> [NSGraph lb] -> String -> String grShowList _ []     = showString "[no graphs]"@@ -1217,11 +1242,11 @@     p ++ "arcs: " ++ showArcs p g     where         showForm = foldr ((++) . (pp ++) . show) "" fml-        fml = listLookupMap (getFormulae g)+        fml = map (uncurry Formula) $ M.assocs (getFormulae g) -- NOTE: want to just show 'name :- graph'         pp = "\n    " ++ p  showArcs :: (Label lb) => String -> NSGraph lb -> String-showArcs p g = foldr ((++) . (pp ++) . show) "" (getArcs g)+showArcs p g = S.foldr ((++) . (pp ++) . show) "" (getArcs g)     where         pp = "\n    " ++ p @@ -1238,7 +1263,15 @@     graphMatch matchable (getArcs g1) (getArcs g2)     where         matchable l1 l2 = mapFormula g1 l1 == mapFormula g2 l2-        mapFormula g l  = mapFindMaybe l (getFormulae g)+	-- hmmm, if we compare the formula, rather then graph,+        -- a lot of tests fail (when the formulae are named by blank+        -- nodes). Presumably because the quality check for Formula forces+        -- the label to be identical, which it needn't be with bnodes+        -- for the match to hold.+        -- mapFormula g l  = M.lookup l (getFormulae g)+        -- mapFormula g l  = fmap formGraph $ M.lookup l (getFormulae g)+        -- the above discussion is hopefully moot now storing graph directly+        mapFormula g l  = M.lookup l (getFormulae g)  -- |Merge RDF graphs, renaming blank and query variable nodes as --  needed to neep variable nodes from the two graphs distinct in@@ -1249,8 +1282,8 @@ --         merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb merge gr1 gr2 =-    let bn1   = allLabels labelIsVar gr1-        bn2   = allLabels labelIsVar gr2+    let bn1   = S.toList $ allLabels labelIsVar gr1+        bn2   = S.toList $ allLabels labelIsVar gr2         dupbn = intersect bn1 bn2         allbn = union bn1 bn2     in addGraphs gr1 (remapLabels dupbn allbn id gr2)@@ -1258,33 +1291,33 @@ -- |Return list of all labels (including properties) in the graph --  satisfying a supplied filter predicate. This routine --  includes the labels in any formulae.-allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]-allLabels p gr = filter p (unionNodes p (formulaNodes p gr) (labels gr) ) +allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set lb+allLabels p gr = S.filter p (unionNodes p (formulaNodes p gr) (labels gr) )                    {- TODO: is the leading 'filter p' needed in allLabels? -}  -- |Return list of all subjects and objects in the graph --  satisfying a supplied filter predicate.-allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]-allNodes p = unionNodes p [] . nodes+allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set lb+allNodes p = unionNodes p S.empty . nodes  -- | List all nodes in graph formulae satisfying a supplied predicate-formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]+formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set 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+        -- fvals = map formGraph $ M.elems fm+        fvals = M.elems fm+        -- TODO: can this conversion be improved?+        fkeys = S.filter p $ S.fromList $ M.keys 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+unionNodes :: (Label lb) => (lb -> Bool) -> S.Set lb -> S.Set lb -> S.Set lb+unionNodes p ls1 ls2 = ls1 `S.union` S.filter p ls2 +-- TODO: use S.Set lb rather than [lb] in the following+ -- |Remap selected nodes in graph. -- --  This is the node renaming operation that prevents graph-scoped@@ -1300,8 +1333,10 @@     -- 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) +remapLabels dupbn allbn cnvbn =+    fmapNSGraph (mapnode dupbn allbn cnvbn)+ -- |Externally callable function to construct a list of (old,new) --  values to be used for graph label remapping. --@@ -1319,7 +1354,7 @@ mapnode ::     (Label lb) => [lb] -> [lb] -> (lb -> lb) -> lb -> lb mapnode dupbn allbn cnvbn nv =-    mapFind nv nv (LookupMap (maplist dupbn allbn cnvbn []))+    M.findWithDefault nv nv $ M.fromList $ maplist dupbn allbn cnvbn []  -- | Construct a list of (oldnode,newnode) values to be used for --  graph label remapping.  The function operates recursively, adding@@ -1387,7 +1422,7 @@  type RDFGraph = NSGraph RDFLabel --- |Create a new RDF graph from a supplied list of arcs.+-- |Create a new RDF graph from a supplied set of arcs. -- -- This version will attempt to fill up the namespace map -- of the graph based on the input labels (including datatypes@@ -1400,19 +1435,20 @@ -- and earlier. -- toRDFGraph :: -    [RDFTriple] -- ^ There is no check to remove repeated statements in this list,-                -- so it is suggested that you use 'Data.List.nub', or convert via 'Data.Set.Set',-                -- if your input may contain such elements.+    RDFArcSet     -> RDFGraph toRDFGraph arcs = -  let lbls = concatMap arcLabels arcs+  let lbls = getComponents arcLabels arcs              getNS (Res s) = Just s       getNS (TypedLit _ dt) = Just dt       getNS _ = Nothing -      ns = mapMaybe (fmap getScopeNamespace . getNS) lbls-      nsmap = foldl' mapAddIfNew emptyNamespaceMap ns+      ns = mapMaybe (fmap getScopeNamespace . getNS) $ S.toList lbls+      nsmap = foldl'+              (\m ins -> let (p,u) = getNamespaceTuple ins+	                in M.insertWith (flip const) p u m)+              emptyNamespaceMap ns      in mempty { namespaces = nsmap, statements = arcs } 

@@ -77,6 +77,7 @@     ( Namespace     , ScopedName     , makeNamespace+    , getNamespaceTuple     , getScopeNamespace     , getScopedNameURI     , getScopeNamespace@@ -138,15 +139,15 @@ import Control.Monad (forM_, foldM)  import Data.Char (isSpace, isDigit, ord, isAsciiLower) -import Data.LookupMap (LookupMap(..), LookupEntryClass(..))-import Data.LookupMap (mapFind, mapFindMaybe, mapAdd, mapReplace) import Data.Maybe (fromMaybe, fromJust) import Data.Word (Word32)  import Network.URI (URI(..), parseURIReference)+import Network.URI.Ord ()  import Text.ParserCombinators.Poly.StateText +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as L @@ -170,13 +171,13 @@ setPrefix :: Maybe T.Text -> URI -> N3State -> N3State setPrefix pre uri st =  st { prefixUris=p' }     where-        p' = mapReplace (prefixUris st) (makeNamespace pre uri) +        p' = M.insert pre uri (prefixUris st)  -- | Set name for special syntax element setSName :: String -> ScopedName -> N3State -> N3State setSName nam snam st =  st { syntaxUris=s' }     where-        s' = mapReplace (syntaxUris st) (nam,snam)+        s' = M.insert nam snam (syntaxUris st)  setSUri :: String -> URI -> N3State -> N3State setSUri nam = setSName nam . makeURIScopedName@@ -190,14 +191,14 @@  -- | Get name for special syntax element, default null getSName :: N3State -> String -> ScopedName-getSName st nam =  mapFind nullScopedName nam (syntaxUris st)+getSName st nam = M.findWithDefault nullScopedName nam $ syntaxUris st  getSUri :: N3State -> String -> URI getSUri st nam = getScopedNameURI $ getSName st nam  --  Map prefix to URI getPrefixURI :: N3State -> Maybe T.Text -> Maybe URI-getPrefixURI st pre = mapFindMaybe pre (prefixUris st)+getPrefixURI st pre = M.lookup pre (prefixUris st)  getKeywordsList :: N3State -> [T.Text] getKeywordsList = keywordsList@@ -251,9 +252,9 @@   Maybe QName  -- ^ starting base for the graph   -> N3State emptyState mbase = -  let pmap   = LookupMap [makeNamespace Nothing hashURI]+  let pmap   = M.singleton Nothing hashURI       muri   = fmap (makeQNameScopedName Nothing) mbase-      smap   = LookupMap $ specialTable muri+      smap   = M.fromList $ specialTable muri   in N3State      { graphState = emptyRDFGraph      , thisNode   = NoNode@@ -311,7 +312,10 @@ -}  addTestPrefixes :: N3Parser ()-addTestPrefixes = stUpdate $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map+addTestPrefixes = stUpdate $ \st -> st { prefixUris = +                                         M.fromList +                                          $ map getNamespaceTuple prefixTable +                                       } -- should append to existing map  {- parsePrefixFromText :: L.Text -> Either String URI@@ -402,22 +406,20 @@ operatorLabel :: ScopedName -> N3Parser RDFLabel operatorLabel snam = do   st <- stGet-  let sns = getScopeNamespace snam+  let (pkey, pval) = getNamespaceTuple $ getScopeNamespace snam       opmap = prefixUris st-      pkey = entryKey sns-      pval = entryVal sns              rval = Res snam       -  -- the lookup and the replacement could be fused-  case mapFindMaybe pkey opmap of+  -- TODO: the lookup and the replacement could be fused+  case M.lookup pkey opmap of     Just val | val == pval -> return rval              | otherwise   -> do-               stUpdate $ \s -> s { prefixUris = mapReplace opmap sns }+               stUpdate $ \s -> s { prefixUris = M.insert pkey pval opmap }                return rval          _ -> do-      stUpdate $ \s -> s { prefixUris = mapAdd opmap sns }+      stUpdate $ \s -> s { prefixUris = M.insert pkey pval opmap }       return rval          {-@@ -440,7 +442,8 @@   let stmt = arc s p o       oldp = prefixUris ost       ogs = graphState ost-      newp = mapReplace oldp (getScopeNamespace dtype)+      (ns, uri) = getNamespaceTuple $ getScopeNamespace dtype+      newp = M.insert ns uri oldp   stUpdate $ \st -> st { prefixUris = newp, graphState = addArc stmt ogs } addStatement s p o = stUpdate (updateGraph (addArc (arc s p o) )) @@ -780,7 +783,7 @@ findPrefix :: T.Text -> N3Parser Namespace findPrefix pre = do   st <- stGet-  case mapFindMaybe (Just pre) (prefixUris st) of+  case M.lookup (Just pre) (prefixUris st) of     Just uri -> return $ makeNamespace (Just pre) uri     Nothing  -> failBad $ "Prefix '" ++ T.unpack pre ++ ":' not bound."   

@@ -65,7 +65,8 @@  import Swish.GraphClass (arc) import Swish.Namespace (Namespace, ScopedName)-import Swish.Namespace (makeNamespace, getScopeNamespace, getScopedNameURI+import Swish.Namespace (makeNamespace, getNamespaceTuple+                       , getScopeNamespace, getScopedNameURI                        , getScopeNamespace, makeURIScopedName, makeNSScopedName) import Swish.QName (newLName, emptyLName) @@ -111,15 +112,15 @@ import Control.Monad (foldM)  import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit) -import Data.LookupMap (LookupMap(..), LookupEntryClass(..))-import Data.LookupMap (mapFindMaybe, mapAdd, mapReplace) import Data.Maybe (fromMaybe, fromJust) import Data.Word (Word32)  import Network.URI (URI(..), parseURIReference)+import Network.URI.Ord ()  import Text.ParserCombinators.Poly.StateText +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as L @@ -140,7 +141,7 @@ setPrefix :: Maybe T.Text -> URI -> TurtleState -> TurtleState setPrefix pre uri st =  st { prefixUris=p' }     where-        p' = mapReplace (prefixUris st) (makeNamespace pre uri) +        p' = M.insert pre uri (prefixUris st)  -- | Change the base setBase :: URI -> TurtleState -> TurtleState@@ -158,7 +159,7 @@  --  Map prefix to URI (naming needs a scrub here) getPrefixURI :: TurtleState -> Maybe T.Text -> Maybe URI-getPrefixURI st pre = mapFindMaybe pre (prefixUris st)+getPrefixURI st pre = M.lookup pre (prefixUris st)  findPrefixNamespace :: Maybe L.Text -> TurtleParser Namespace findPrefixNamespace (Just p) = findPrefix (L.toStrict p)@@ -204,7 +205,7 @@   Maybe URI  -- ^ starting base for the graph   -> TurtleState emptyState mbase = -  let pmap   = LookupMap [makeNamespace Nothing hashURI]+  let pmap   = M.singleton Nothing hashURI       buri   = fromMaybe (getScopedNameURI defaultBase) mbase   in TurtleState      { graphState = emptyRDFGraph@@ -278,7 +279,8 @@   let stmt = arc s p o       oldp = prefixUris ost       ogs = graphState ost-      newp = mapReplace oldp (getScopeNamespace dtype)+      (nspre, nsuri) = getNamespaceTuple $ getScopeNamespace dtype+      newp = M.insert nspre nsuri oldp   stUpdate $ \st -> st { prefixUris = newp, graphState = addArc stmt ogs } addStatement s p o = stUpdate (updateGraph (addArc (arc s p o) )) @@ -313,34 +315,34 @@   - could we use the reverse lookupmap functionality to     find if the given namespace URI is in the namespace     list? If it is, use it's key otherwise do a-    mapReplace for the input namespace.+    mapReplace for the input namespace (updated to use the+    Data.Map.Map representation).      -} operatorLabel :: ScopedName -> TurtleParser RDFLabel operatorLabel snam = do   st <- stGet-  let sns = getScopeNamespace snam+  let (pkey, pval) = getNamespaceTuple $ getScopeNamespace snam       opmap = prefixUris st-      pkey = entryKey sns-      pval = entryVal sns              rval = Res snam       -  -- the lookup and the replacement could be fused-  case mapFindMaybe pkey opmap of+  -- TODO: the lookup and the replacement could be fused; it may not+  --       even make sense to separate now using a Map+  case M.lookup pkey opmap of     Just val | val == pval -> return rval              | otherwise   -> do-               stUpdate $ \s -> s { prefixUris = mapReplace opmap sns }+               stUpdate $ \s -> s { prefixUris = M.insert pkey pval opmap }                return rval          _ -> do-      stUpdate $ \s -> s { prefixUris = mapAdd opmap sns }+      stUpdate $ \s -> s { prefixUris = M.insert pkey pval opmap }       return rval          findPrefix :: T.Text -> TurtleParser Namespace findPrefix pre = do   st <- stGet-  case mapFindMaybe (Just pre) (prefixUris st) of+  case M.lookup (Just pre) (prefixUris st) of     Just uri -> return $ makeNamespace (Just pre) uri     Nothing  -> failBad $ "Undefined prefix '" ++ T.unpack pre ++ ":'." 

@@ -66,13 +66,13 @@     )  import Data.Char (isSpace, isHexDigit, chr)-import Data.LookupMap (LookupMap(..)) import Data.Maybe (fromMaybe, fromJust)  import Network.URI (URI(..), relativeTo, parseURIReference)  import Text.ParserCombinators.Poly.StateText +import qualified Data.Map       as M import qualified Data.Text      as T import qualified Data.Text.Lazy as L import qualified Data.Text.Read as R@@ -94,26 +94,7 @@     _  -> Right uri    -- | Type for special name lookup table-type SpecialMap = LookupMap (String, ScopedName)--{---- | Lookup prefix in table and return the matching URI.------   If the prefix is unknown then we currently error---   out (used to return 'prefix:' or ':' but now using---   URIs I am changing this behavior). This may well be---   backed out.-mapPrefix :: NamespaceMap -> Maybe String -> URI-mapPrefix pmap pfix = -  case mapFindMaybe pfix pmap of-    Just uri -> uri-    Nothing  -> error $ "Unable to find prefix: " ++ show pfix -- fromMaybe "" pfix ++ ":"--}-  -{--mapPrefix ps p@(Just pre) = mapFind (pre++":") p ps-mapPrefix ps _ = mapFind ":" Nothing ps--}+type SpecialMap = M.Map String ScopedName  -- | Define default table of namespaces prefixTable :: [Namespace]

@@ -36,17 +36,19 @@ import Swish.Rule (Expression(..), Rule(..)) import Swish.VarBinding (makeVarBinding) -import Swish.RDF.Graph (RDFLabel(..), RDFGraph)+import Swish.RDF.Graph (RDFLabel(..), RDFGraph, fmapNSGraph) import Swish.RDF.Graph (merge, allLabels, remapLabelList) import Swish.RDF.Query (rdfQueryInstance, rdfQuerySubs) import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleset) -import Swish.Utils.ListHelpers (subset, flist)+import Swish.Utils.ListHelpers (flist)  import Data.List (subsequences)-import Data.LookupMap (makeLookupMap, mapFind) import Data.Monoid (Monoid(..)) +import qualified Data.Map as M+import qualified Data.Set as S+ ------------------------------------------------------------ --  Type instantiation of Proof framework for RDFGraph data ------------------------------------------------------------@@ -65,9 +67,10 @@ --  @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 = null . getArcs  +instance (Label lb, LDGraph lg lb, Eq (lg lb)) => Expression (lg lb) where+    isValid = S.null . getArcs + ------------------------------------------------------------ --  Define RDF-specific types for proof framework ------------------------------------------------------------@@ -167,11 +170,13 @@         --  Obtain lists of variable and non-variable nodes         --  (was: nonvarNodes = allLabels (not . labelIsVar) mergeGraph)         nonvarNodes = vocab-        varNodes    = allLabels labelIsVar mergeGraph+        varNodes    = S.toList $ allLabels labelIsVar mergeGraph         --  Obtain list of possible remappings for non-variable nodes         mapList     = remapLabelList nonvarNodes varNodes         mapSubLists = (tail . subsequences) mapList-        mapGr ls = fmap (\l -> mapFind l l (makeLookupMap ls))+        mapGr ls = fmapNSGraph +	           (\l -> M.findWithDefault l l+                          (M.fromList ls))     in         --  Return all remappings of the original merged graph         flist (map mapGr mapSubLists) mergeGraph@@ -190,7 +195,7 @@ rdfInstanceEntailBwdApply vocab cons =     let         --  Obtain list of variable nodes-        varNodes     = allLabels labelIsVar cons+        varNodes     = S.toList $ allLabels labelIsVar cons         --  Generate a substitution for each combination of variable         --  and vocabulary node.         varBindings  = map (makeVarBinding . zip varNodes) vocSequences@@ -298,7 +303,8 @@                         else foldl1 merge ante     in         --  Return all subgraphs of the full graph constructed above-        map (setArcs mergeGraph) (init $ tail $ subsequences $ getArcs mergeGraph)+        -- TODO: update to use sets as appropriate+        map (setArcs mergeGraph . S.fromList) (init $ tail $ subsequences $ S.toList $ getArcs mergeGraph)  --  Subgraph entailment inference checker --@@ -313,7 +319,7 @@                         else foldl1 addGraphs ante     in         --  Check each consequent graph arc is in the antecedent graph-        getArcs cons `subset` getArcs fullGraph+        getArcs cons `S.isSubsetOf` getArcs fullGraph  ------------------------------------------------------------ --  RDF simple entailment inference rule

@@ -67,6 +67,7 @@     , resRdfFirst     , resRdfRest     , resRdfNil+    , traverseNSGraph     )  import Swish.RDF.VarBinding (RDFVarBinding, RDFVarBindingFilter)@@ -85,12 +86,18 @@ import Data.Monoid (Monoid(..))  import qualified Data.Set as S-import qualified Data.Traversable as Traversable  ------------------------------------------------------------ --  Primitive RDF graph queries ------------------------------------------------------------ +-- Get a list of arcs from a graph.+-- +-- Can we update the routines to work with sets instead?++getTriples :: RDFGraph -> [RDFTriple]+getTriples = S.toList . getArcs+ -- | Basic graph-query function. -- --  The triples of the query graph are matched sequentially@@ -106,7 +113,7 @@   -- ^ Each element represents a set of variable bindings that make the query graph a   -- subgraph of the target graph. The list can be empty. rdfQueryFind =-    rdfQueryPrim1 matchQueryVariable nullRDFVarBinding . getArcs+    rdfQueryPrim1 matchQueryVariable nullRDFVarBinding . getTriples  --  Helper function to match query against a graph. --  A node-query function is supplied to determine how query nodes@@ -119,15 +126,13 @@     -> [RDFVarBinding] rdfQueryPrim1 _     initv []       _  = [initv] rdfQueryPrim1 nodeq initv (qa:qas) tg =-    let-        qam  = fmap (applyVarBinding initv) qa      -- subst vars already bound+    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-            ]+    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@@ -139,7 +144,7 @@     -> RDFGraph     -> [RDFVarBinding] rdfQueryPrim2 nodeq qa tg =-        mapMaybe (getBinding nodeq qa) (getArcs tg)+        mapMaybe (getBinding nodeq qa) (S.toList $ getArcs tg)  -- |RDF query filter. --@@ -195,9 +200,13 @@ --  An empty outer list is returned if no combination of --  substitutions can infer the supplied target. ---rdfQueryBack :: RDFGraph -> RDFGraph -> [[RDFVarBinding]]+rdfQueryBack :: +    RDFGraph    -- ^ Query graph+    -> RDFGraph -- ^ Target graph+    -> [[RDFVarBinding]] rdfQueryBack qg tg =-    rdfQueryBack1 matchQueryVariable [] (getArcs qg) (getArcs tg)+    let ga = getTriples+    in rdfQueryBack1 matchQueryVariable [] (ga qg) (ga tg)  rdfQueryBack1 ::     NodeQuery RDFLabel -> [RDFVarBinding] -> [Arc RDFLabel] -> [Arc RDFLabel]@@ -281,7 +290,7 @@ --  has been concluded. rdfQueryInstance :: RDFGraph -> RDFGraph -> [RDFVarBinding] rdfQueryInstance =-    rdfQueryPrim1 matchQueryBnode nullRDFVarBinding . getArcs+    rdfQueryPrim1 matchQueryBnode nullRDFVarBinding . getTriples  ------------------------------------------------------------ --  Primitive RDF graph query support functions@@ -382,7 +391,7 @@     [ remapLabels vs bs makeBlank g     | v <- vars     , let (g,vs) = rdfQuerySubs2 v gr-    , let bs     = allLabels isBlank g+    , let bs     = S.toList $ allLabels isBlank g     ]  -- |Graph back-substitution function, replacing variables with bnodes.@@ -404,10 +413,10 @@ --  unbound variables. -- --  Adding an empty graph forces elimination of duplicate arcs.-rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel])-rdfQuerySubs2 varb gr = (addGraphs mempty g, S.toList vs)+rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph, [RDFLabel])+rdfQuerySubs2 varb gr = (addGraphs mempty g, S.toList vs) -- the addgraphs part is important, possibly just to remove duplicated entries     where-        (g,vs) = runState ( Traversable.traverse (mapNode varb) gr ) S.empty+        (g,vs) = runState (traverseNSGraph (mapNode varb) gr) S.empty  --  Auxiliary monad function for rdfQuerySubs2. --  This returns a state transformer Monad which in turn returns the@@ -477,7 +486,7 @@ --  Custom predicates can also be used. -- rdfFindArcs :: (RDFTriple -> Bool) -> RDFGraph -> [RDFTriple]-rdfFindArcs p = filter p . getArcs+rdfFindArcs p = S.toList . S.filter p . getArcs  -- |Test if statement has given subject rdfSubjEq :: RDFLabel -> RDFTriple -> Bool

@@ -48,7 +48,7 @@ import Swish.Rule (Formula(..), Rule(..), RuleMap) import Swish.Rule (fwdCheckInference, nullSN) import Swish.Ruleset (Ruleset(..), RulesetMap)-import Swish.GraphClass (Label(..), Arc(..), LDGraph(..))+import Swish.GraphClass (Label(..), ArcSet, LDGraph(..)) import Swish.VarBinding (VarBindingModify(..)) import Swish.VarBinding (makeVarBinding, applyVarBinding, joinVarBindings, vbmCompose, varBindingId) @@ -60,7 +60,7 @@     )  import Swish.RDF.Graph-    ( RDFLabel(..), RDFGraph+    ( RDFLabel(..), RDFGraph, RDFArcSet     , makeBlank, newNodes     , merge, allLabels     , toRDFGraph)@@ -70,12 +70,13 @@  import Swish.RDF.Vocabulary (swishName, namespaceRDF, namespaceRDFS) -import Swish.Utils.ListHelpers (equiv, flist)+import Swish.Utils.ListHelpers (flist)  import Data.List (nub) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) +import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as B  ------------------------------------------------------------@@ -88,7 +89,7 @@ -- | A named inference rule expressed in RDF. type RDFRule        = Rule RDFGraph --- | A 'LookupMap' for 'RDFRule' rules.+-- | A map for 'RDFRule' rules. type RDFRuleMap     = RuleMap RDFGraph  -- | A 'GraphClosure' for RDF statements.@@ -97,7 +98,7 @@ -- | A 'Ruleset' for RDF. type RDFRuleset     = Ruleset RDFGraph --- | 'LookupMap' for 'RDFRuleset'.+-- | A map for 'RDFRuleset'. type RDFRulesetMap  = RulesetMap RDFGraph  ------------------------------------------------------------@@ -118,9 +119,9 @@ -- |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+    , ruleAnt       :: ArcSet lb    -- ^ Antecedent triples pattern                                     --   (may include variable nodes)-    , ruleCon       :: [Arc lb]     -- ^ Consequent triples pattern+    , ruleCon       :: ArcSet lb    -- ^ Consequent triples pattern                                     --   (may include variable nodes)     , ruleModify    :: VarBindingModify lb lb                                     -- ^ Structure that defines additional@@ -133,10 +134,12 @@                                     --   arising from graph queries.     } +-- | Equality is based on the closure rule, anrecedents and+--   consequents. instance (Label lb) => Eq (GraphClosure lb) where     c1 == c2 = nameGraphRule c1 == nameGraphRule c2 &&-               ruleAnt c1 `equiv` ruleAnt c2 &&-               ruleCon c1 `equiv` ruleCon c2+               ruleAnt c1 == ruleAnt c2 &&+               ruleCon c1 == ruleCon c2  instance (Label lb) => Show (GraphClosure lb) where     show c = "GraphClosure " ++ show (nameGraphRule c)@@ -213,16 +216,16 @@ --  RDF graph query and substitution support functions ------------------------------------------------------------ -queryFind :: [Arc RDFLabel] -> RDFGraph -> [RDFVarBinding]+queryFind :: RDFArcSet -> RDFGraph -> [RDFVarBinding] queryFind qas = rdfQueryFind (toRDFGraph qas) -queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]+queryBack :: RDFArcSet -> RDFGraph -> [[RDFVarBinding]] queryBack qas = rdfQueryBack (toRDFGraph qas) -querySubs :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]+querySubs :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph] querySubs vars = rdfQuerySubs vars . toRDFGraph -querySubsBlank :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]+querySubsBlank :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph] querySubsBlank vars = rdfQuerySubsBlank vars . toRDFGraph  ------------------------------------------------------------@@ -293,7 +296,7 @@ makeRDFClosureRule sname antgrs congr vmod = makeGraphClosureRule     GraphClosure         { nameGraphRule = sname-        , ruleAnt       = concatMap getArcs antgrs+        , ruleAnt       = S.unions $ map getArcs antgrs         , ruleCon       = getArcs congr         , ruleModify    = vmod         }@@ -429,7 +432,7 @@     where         antgr = makeRDFGraphFromN3Builder ant         congr = makeRDFGraphFromN3Builder con-        vmod  = aloc (allLabels labelIsVar antgr)+        vmod  = aloc $ S.toList (allLabels labelIsVar antgr)         modc  = fromMaybe varBindingId $ vbmCompose vmod vflt  ------------------------------------------------------------

@@ -32,6 +32,7 @@     ) where +import Swish.Namespace (ScopedName) import Swish.VarBinding (VarBinding(..), VarBindingModify(..), OpenVarBindingModify, VarBindingFilter(..)) import Swish.VarBinding (nullVarBinding, applyVarBinding, makeVarTestFilter) @@ -42,7 +43,7 @@     ) import Swish.RDF.Vocabulary (swishName) -import Data.LookupMap (LookupMap(..))+import qualified Data.Map as M  ------------------------------------------------------------ --  Types for RDF query variable bindings and modifiers@@ -64,7 +65,7 @@ type RDFOpenVarBindingModify = OpenVarBindingModify RDFLabel RDFLabel  -- |Define type for lookup map of open query binding modifiers-type RDFOpenVarBindingModifyMap = LookupMap RDFOpenVarBindingModify+type RDFOpenVarBindingModifyMap = M.Map ScopedName RDFOpenVarBindingModify  -- |@RDFVarBindingFilter@ is a function type that tests to see if --  a query binding satisfies some criterion, and is used to

@@ -203,6 +203,9 @@ instance Eq LanguageTag where     LanguageTag _ t1 == LanguageTag _ t2 = t1 == t2 +instance Ord LanguageTag where+    LanguageTag _ t1 `compare` LanguageTag _ t2 = t1 `compare` t2+ -- | Create a 'LanguageTag' element from the label. --  -- Valid tags follow the ABNF from RCF 3066, which is

@@ -1,4 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}  --------------------------------------------------------------------------------@@ -11,7 +10,7 @@ -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  MultiParamTypeClasses, OverloadedStrings+--  Portability :  OverloadedStrings -- --  This module defines a framework for defining inference rules --  over some expression form.  It is intended to be used with@@ -32,12 +31,13 @@ import Swish.Namespace (makeNamespace, makeNSScopedName) import Swish.QName (LName) -import Data.LookupMap (LookupEntryClass(..), LookupMap(..)) import Data.Maybe (fromJust) import Data.String.ShowLines (ShowLines(..))  import Network.URI (URI, parseURI) +import qualified Data.Map as M+ ------------------------------------------------------------ --  Expressions ------------------------------------------------------------@@ -67,11 +67,6 @@ 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@ with the prefix @null:@. nullScope :: Namespace nullScope = makeNamespace (Just "null") nullScopeURI@@ -175,13 +170,8 @@ 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)---- | A 'LookupMap' for a 'Rule'.-type RuleMap ex = LookupMap (Rule ex)+-- | A set of rules labelled with their name.+type RuleMap ex = M.Map ScopedName (Rule ex)  -- | Checks that consequence is a result of -- applying the rule to the antecedants.

@@ -1,5 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-}- -------------------------------------------------------------------------------- --  See end of this file for licence information. --------------------------------------------------------------------------------@@ -10,7 +8,7 @@ -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  MultiParamTypeClasses+--  Portability :  H98 -- --  This module defines a ruleset data type, used to collect information --  about a ruleset that may contribute torwards inferences in RDF;@@ -42,9 +40,10 @@ import Data.List (intercalate) -} -import Data.LookupMap (LookupEntryClass(..), LookupMap(..), mapFindMaybe) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) +import qualified Data.Map as M+ -- | A Rule set.  data Ruleset ex = Ruleset@@ -70,13 +69,8 @@ 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---- | A 'LookupMap' for a 'Ruleset'.-type RulesetMap ex = LookupMap (Ruleset ex)+-- | A set of Rulesets labelled by their Namespace.+type RulesetMap ex = M.Map Namespace (Ruleset ex)  -- | Create a ruleset. makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex@@ -101,14 +95,12 @@ -- | Find a named axiom in a ruleset. getRulesetAxiom :: ScopedName -> Ruleset ex -> Maybe (Formula ex) getRulesetAxiom nam rset =-    mapFindMaybe nam (LookupMap (getRulesetAxioms rset))-    -- listToMaybe $ filter ( (matchName nam) . formName ) $ getRulesetAxioms rset+    M.lookup nam $ M.fromList $ map (\f -> (formName f, f)) (rsAxioms rset)  -- | Find a named rule in a ruleset.  getRulesetRule :: ScopedName -> Ruleset ex -> Maybe (Rule ex) getRulesetRule nam rset =-    mapFindMaybe nam (LookupMap (getRulesetRules rset))-    -- listToMaybe $ filter ( (matchName nam) . ruleName ) $ getRulesetRules rset+    M.lookup nam $ M.fromList $ map (\r -> (ruleName r, r)) (rsRules rset)  -- | Find a named axiom in a proof context. getContextAxiom :: @@ -117,9 +109,6 @@   -> [Ruleset ex] -- ^ Rulesets to search.   -> Formula ex getContextAxiom nam def rsets = fromMaybe def (getMaybeContextAxiom nam rsets)-    {--    foldr (flip fromMaybe) def $ map (getRulesetAxiom nam) rsets-    -}  -- | Find a named axiom in a proof context. getMaybeContextAxiom ::@@ -136,9 +125,6 @@   -> [Ruleset ex] -- ^ Rulesets to search.   -> Rule ex getContextRule nam def rsets = fromMaybe def (getMaybeContextRule nam rsets)-    {--    foldr (flip fromMaybe) def $ map (getRulesetRule nam) rsets-    -}  -- | Find a named rule in a proof context. getMaybeContextRule :: 

@@ -72,7 +72,7 @@ where  import Swish.Datatype (typeMkRules)-import Swish.Monad ( SwishStateIO, SwishStatus(..), NamedGraph(..))+import Swish.Monad ( SwishStateIO, SwishStatus(..)) import Swish.Monad (modGraphs, findGraph, findFormula                    , modRules, findRule                    , modRulesets, findRuleset@@ -80,7 +80,7 @@                    , setInfo, setError, setStatus) import Swish.Proof (explainProof, showsProof) import Swish.Rule (Formula(..), Rule(..)) -import Swish.Ruleset (makeRuleset, getRulesetRule, getMaybeContextRule)+import Swish.Ruleset (makeRuleset, getRulesetRule, getRulesetNamespace, getMaybeContextRule) import Swish.VarBinding (composeSequence)  import Swish.RDF.Datatype (RDFDatatype)@@ -119,23 +119,24 @@  import Swish.RDF.Formatter.N3 (formatGraphAsBuilder) -import Swish.Utils.ListHelpers (equiv, flist)+import Swish.Utils.ListHelpers (flist) -import qualified Data.Text.Lazy as L-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy.IO as LIO import Text.ParserCombinators.Poly.StateText  import Control.Monad (unless, when, liftM, void) import Control.Monad.State (modify, gets, lift) -import Data.LookupMap (mapReplace) import Data.Monoid (Monoid(..))  import Network.URI (URI(..)) -import qualified System.IO.Error as IO import qualified Control.Exception as CE+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Lazy.IO as LIO+import qualified System.IO.Error as IO  ------------------------------------------------------------ --@@ -460,7 +461,7 @@             ; let egs = sequence esg    -- Either String [RDFGraph]             ; let fgs = case egs of                     Left  er -> setError  (errmsg++er)-                    Right gs -> modGraphs (`mapReplace` NamedGraph nam gs)+                    Right gs -> modGraphs (M.insert nam gs)             ; modify fgs             } @@ -547,7 +548,7 @@             ; let fgs = case egs of                     Left  er -> setError  (errmsg++er)                     Right [] -> setError  (errmsg++"No graphs to merge")-                    Right gs -> modGraphs (`mapReplace` NamedGraph nam [g])+                    Right gs -> modGraphs (M.insert nam [g])                             where g = foldl1 merge gs             ; modify fgs             }@@ -571,7 +572,7 @@                 (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 $+                    when (S.fromList gr1 /= S.fromList gr2) $ modify $                       setError (comment++":\n  Graph "++show n1                                 ++" differs from "++show n2++".")             }@@ -629,7 +630,7 @@                             newRule = makeRDFClosureRule rn agrs cgr                         in                         case composeSequence vbms of-                            Just vm -> modRules (`mapReplace` newRule vm)+                            Just vm -> let nr = newRule vm in modRules (M.insert (ruleName nr) nr)                             Nothing -> setError errmsg4             ; modify frl             }@@ -662,7 +663,7 @@                     (Left er,_) -> setError (errmsg1++er)                     (_,Left er) -> setError (errmsg2++er)                     (Right ags,Right rls) ->-                        modRulesets (`mapReplace` rs)+                        modRulesets (M.insert (getRulesetNamespace rs) rs)                         where                             rs = makeRuleset (getScopeNamespace sn) ags rls             ; modify frs@@ -697,7 +698,7 @@                     (Left er,_) -> setError (errmsg1++er)                     (_,Left er) -> setError (errmsg2++er)                     (Right cgr,Right dts) ->-                        modRulesets (`mapReplace` rs)+                        modRulesets (M.insert (getRulesetNamespace rs) rs)                         where                             rs  = makeRuleset (getScopeNamespace sn) [] rls                             rls = concatMap (`typeMkRules` cgr) dts@@ -812,7 +813,7 @@                     (Left er,_) -> setError (errmsg1++er)                     (_,Left er) -> setError (errmsg2++er)                     (Right rl,Right ags) ->-                        modGraphs (`mapReplace` NamedGraph cn [cg])+                        modGraphs (M.insert cn [cg])                         where                             cg = case fwdApply rl ags of                                 []  -> mempty@@ -857,7 +858,7 @@                     (Left er,_) -> setError (errmsg1++er)                     (_,Left er) -> setError (errmsg2++er)                     (Right rl,Right cg) ->-                        modGraphs (`mapReplace` NamedGraph an ags)+                        modGraphs (M.insert an ags)                         where                             ags  = map mergegr (bwdApply rl cg)                             mergegr grs = case grs of

@@ -10,41 +10,9 @@ --  Stability   :  experimental --  Portability :  H98 -----  This module defines some generic list and related helper functions. The plan---  is to move to using functionality from other modules (e.g. containers) where---  possible.--- -------------------------------------------------------------------------------- -module Swish.Utils.ListHelpers-       ( -- list of modules the routine is used in-         subset -- Proof, RDF.Proof, VarBinding [also defined in Data.Ord.Partial]-       , equiv -- GraphMatch, RDF.Ruleset, Script, VarBinding, Data.LookupMap-       , flist -- Datatype, RDF.Proof, RDF.Ruleset, Script, VarBinding, ...-        -      )-where-----------------------------------------------------------------  Set functions------  NOTE: to change to Data.Set then Eq a constraint will ---        likely need changing to Ord a----------------------------------------------------------------- |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-----------------------------------------------------------------  Functions, lists and monads-------------------------------------------------------------+module Swish.Utils.ListHelpers (flist) where  -- |Apply list of functions to some value, returning list of results. --  It's kind of like an converse map.

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -13,7 +12,7 @@ -- --  Maintainer  :  Douglas Burke --  Stability   :  experimental---  Portability :  FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TypeSynonymInstances+--  Portability :  FlexibleInstances, OverloadedStrings, TypeSynonymInstances -- --  This module defines functions for representing and manipulating query --  binding variable sets.  This is the key data that mediates between@@ -29,6 +28,7 @@     , boundVars, subBinding, makeVarBinding     , applyVarBinding, joinVarBindings, addVarBinding     , VarBindingModify(..), OpenVarBindingModify+    , openVbmName     , vbmCompatibility, vbmCompose     , composeSequence, findCompositions, findComposition     , VarBindingFilter(..)@@ -45,73 +45,89 @@  import Swish.RDF.Vocabulary (swishName) -import Swish.Utils.ListHelpers (equiv, subset, flist)+import Swish.Utils.ListHelpers (flist) +import Control.Applicative ((<$>), (<*>))+import Control.Monad (mplus)++import Data.Function (on) import Data.List (find, intersect, union, (\\), foldl', permutations)-import Data.LookupMap (LookupEntryClass(..), makeLookupMap, mapFindMaybe) import Data.Maybe (mapMaybe, fromMaybe, isJust, fromJust, listToMaybe)-import Data.Monoid (mconcat)+import Data.Monoid (Monoid(..), mconcat)+import Data.Ord (comparing) +import qualified Data.Map as M+import qualified Data.Set as S+ ------------------------------------------------------------ --  Query variable bindings ------------------------------------------------------------ --- TODO: is it worth making a Monoid instance of VarBinding?- -- |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)]+    , vbEnum :: S.Set (a,b)     , vbNull :: Bool     } --- |VarBinding is an instance of class Eq, so that variable---  bindings can be compared for equivalence+-- | The Eq instance is defined as the set equivalence of the+--   pairs of variables in the binding. ---instance (Eq a, Eq b) => Eq (VarBinding a b) where-    vb1 == vb2 = vbEnum vb1 `equiv` vbEnum vb2+instance (Ord a, Ord b) => Eq (VarBinding a b) where+    (==) = (==) `on` vbEnum --- |VarBinding is an instance of class Show, so that variable---  bindings can be displayed+-- | The Ord instance is defined only on the pairs of+--   variables in the binding.+instance (Ord a, Ord b) => Ord (VarBinding a b) where+    compare = comparing vbEnum++-- | When combining instances, if there is an overlapping binding then+--   the  value from the first instance is used.+instance (Ord a, Ord b) => Monoid (VarBinding a b) where+    mempty = nullVarBinding+    mappend = joinVarBindings++-- | The Show instance only displays the pairs of variables+--    in the binding. -- instance (Show a, Show b) => Show (VarBinding a b) where-    show = show . vbEnum+    show = show . S.toList . vbEnum --- | maps no query variables.+-- | The null, or empry, binding maps no query variables.+--   This is the 'mempty' instance of the Monoid. -- nullVarBinding :: VarBinding a b nullVarBinding = VarBinding     { vbMap  = const Nothing-    , vbEnum = []+    , vbEnum = S.empty     , vbNull = True     }  -- |Return a list of the variables bound by a supplied variable binding ---boundVars :: VarBinding a b -> [a]-boundVars = map fst . vbEnum+boundVars :: (Ord a, Ord b) => VarBinding a b -> S.Set a+boundVars = S.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+subBinding :: (Ord a, Ord b) => VarBinding a b -> VarBinding a b -> Bool+subBinding = S.isSubsetOf `on` vbEnum  -- |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 :: (Ord a, Ord b) => [(a,b)] -> VarBinding a b makeVarBinding [] = nullVarBinding makeVarBinding vrbs =-    let selectFrom = flip mapFindMaybe . makeLookupMap-    in VarBinding-           { vbMap  = selectFrom vrbs-           , vbEnum = vrbs-           , vbNull = False-           }+    VarBinding+    { vbMap  = flip M.lookup (M.fromList vrbs)+    , vbEnum = S.fromList vrbs+    , vbNull = False+    }  -- |Apply query binding to a supplied value, returning the value --  unchanged if no binding is defined@@ -122,35 +138,30 @@ -- |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.+--  the value from the first binding provided is used. ---joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b+joinVarBindings :: (Ord a, Ord b) => 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+        , vbEnum = S.map (\v -> (v,fromJust (mv12 v))) bv12         , vbNull = False         }     where-        mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]-        bv12 = boundVars vb1 `union` boundVars vb2---- |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+        mv12 n = vbMap vb1 n `mplus` vbMap vb2 n+        bv12 = boundVars vb1 `S.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+addVarBinding :: +    (Ord a, Ord b) +    => a +    -> b      -> VarBinding a b+    -> VarBinding a b addVarBinding lb val vbind = joinVarBindings vbind $ makeVarBinding [(lb,val)]  ------------------------------------------------------------@@ -216,14 +227,6 @@                             --  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. --@@ -242,16 +245,7 @@ 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.---+-- | Displays the name of the modifier. instance Show (OpenVarBindingModify a b)     where         show = show . openVbmName@@ -458,9 +452,7 @@ makeVarTestFilter nam vtest var = VarBindingFilter     { vbfName   = nam     , vbfVocab  = [var]-    , vbfTest   = \vb -> case vbMap vb var of-                    Just val  -> vtest val-                    _         -> False+    , vbfTest   = \vb -> maybe False vtest (vbMap vb var)     }  -- |Make a variable comparison filter for named variables using@@ -470,9 +462,7 @@ 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+    , vbfTest   = \vb -> fromMaybe False (vcomp <$> vbMap vb v1 <*> vbMap vb v2)     }  ------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:               swish-Version:            0.7.0.2+Version:            0.8.0.0 Stability:          experimental License:            LGPL License-file:       LICENSE @@ -44,88 +44,30 @@   .   * Complete, ready-to-run, command-line and script-driven programs.   .-  Changes in version @0.7.0.2@:-  .-  * The @Swish.QName.LName@ type now requires all characters to be-  ASCII. This avoids downstream errors when trying to convert a-  @QName@ to a @URI@.-  .-  Changes in version @0.7.0.1@:-  .-  * Internal changes to parsing of URI values for NTriples, Turtle, and N3-  parsers (error messages will be slightly different when IRIs are used).-  Unfortunately IRIs are still not supported. -  .-  Changes in version @0.7.0.0@:-  .-  For code that uses the Swish script language, the main change is to import @Swish@ rather-  than @Swish.RDF.SwishMain@, and to note that the other @Swish.RDF.Swish*@ modules are-  now called @Swish.*@.-  .-  For code that uses the graph library, the main changes are that @Swish.RDF.RDFGraph@-  is now called @Swish.RDF.Graph@, the @Lit@ constructor of the @RDFLabel@ has been split-  into three (@Lit@, @LangLit@, and @TypedLit@) and a new @LanguageTag@ type introduced,-  local names now use the @LName@ type (previously they were just @Text@ values), and the-  parsers and formatters have renamed to-  @Swish.RDF.Parser.*@ and @Swish.RDF.Formatter.*@.-  .-  * Moved a number of modules around: generic code directly into @Swish@-  and the @Swish.RDF.RDF*@ forms renamed to @Swish.RDF.*@. Some modules-  have been moved out of the @Swish.Utils.*@ namespace. Generic modules-  have been placed into the @Data.*@ namespace. The @Swish.RDF.Swish*@-  modules have been moved to @Swish.*@ and @Swish.RDF.SwishMain@ has-  been removed; use @Swish@ instead.-  .-  * Parsing modules are now in the @Swish.RDF.Parser@ hierarchy and-  @Swish.RDF.RDFParser@ has been renamed to @Swish.RDF.Parser.Utils@.-  .-  * Formatting modules are now in the @Swish.RDF.Formatter@ hierarchy.-  .-  * RDF literals are now stored using the @Lit@, @LangLit@, or @TypedLit@ constructors-  (@RDFLabel@) rather than using just @Lit@. Language codes are now represented-  by @Swish.RDF.Vocabulary.LanguageTag@ rather than as a @ScopedName@.-  .-  * Local names are now represented by the @Swish.QName.LName@ type -  rather than as a @Text@ value. A few routines now return a @Maybe@ value-  rather than error-ing out on invalid input.-  .-  * Make use of @Data.List.NonEmpty@ in a few cases.-  .-  * Removed @mkTypedLit@ from @Swish.RDF.RDFParser@; use-  @Swish.RDF.RDFDatatype.makeDataTypedLiteral@ instead.-  .-  * Removed @asubj@, @apred@ and @aobj@ from @Swish.RDF.GraphClass@ and-  @Swish.RDF.RDFGraph@; use @arcSubj@, @arcPred@ or @arcObj@ instead.-  .-  * Removed un-used @containedIn@ element of the @LDGraph@ type class.-  The arguments to @setArcs@ have been flipped, @replaceArcs@ removed,-  @add@ renamed to @addGraphs@, and @emptyGraph@ added.-  .-  * Removed un-used exports from @Swish.Utils.PartOrderedCollection@: -  @partCompareOrd@, @partCompareMaybe@, @partCompareListOrd@, and-  @partCompareListPartOrd@.-  .-  * Removed the @Swish.Utils.MiscHelpers@ module and moved single-use functionality-  out of @Swish.Utils.ListHelpers@.-  .-  * Removed various exported symbols from a range of modules as they were-  unused.+  Changes in version @0.8.0.0@:   .-  * Use @Word32@ rather than @Int@ for label indexes (@Swish.GraphMatch.LabelIndex@)-  and in the bnode counts when formatting to N3/Turtle.+  * The @LDGraph@ class now uses @Set (Arc lb)@, rather than @[Arc lb]@,+  for @setArcs@, @getArcs@, and @update@. Several data types - e.g.+  @NSGraph@ - now use sets rather than lists. There are a number of API tweaks -+  e.g. the addition of Ord constraints and the removal of Functor, Foldable,+  and Traversable instances. Not all list of Arcs have been converted+  since a review is needed to see where it makes sense and where it does not.+  This definitely speeds up some operations but+  a full analysis has not been attempted.   .-  * Minor clean up of the @LookupMap@ module: @mergeReplaceOrAdd@ and @mergeReplace@-  are now combined into @mergeReplace@; @mapSelect@, @mapApplyToAll@, and-  @mapTranslate*@ have been removed; documentation slightly improved;-  and a few minor internal clean ups.+  * Replaced used of @Data.LookupMap@ with @Data.Map.Map@. This has led to the+  removal of a number of language extensions from some modules.   .-  * Clarified that @Swish.RDF.RDFDatatypeXsdDecimal@ is for @xsd:decimal@ rather-  than @xsd:double@.+  * Added @Network.URI.Ord@ to provide an ordering for URIs.   .-  * Support using versions 0.8 or 0.9 of the @intern@ package and version 0.5 of-  @containers@.+  * A few other minor changes have been made: the removal of @subset@ and+  @equiv@ from+  @Swish.Utils.ListHelpers@; the ordering used for @RDFLabel@ values has+  changed; added a @Monoid@ instance for @VarBinding@; added @Ord@+  instances for a number of containers; removed some un-needed constraints;+  added @Network.URI.Ord@.   .-  * Switch to @Control.Exception.try@ to avoid deprecation warnings from @System.IO.Error.try@.+  * The containers upper limit has been increased to support version 0.5.   .   Changes in previous versions can be found at <https://bitbucket.org/doug_burke/swish/src/tip/CHANGES>.   .@@ -158,7 +100,7 @@    Build-Depends:       base >=3 && < 5,       binary == 0.5.*,-      containers >= 0.3 && < 0.6,+      containers >= 0.4 && < 0.6,       directory >= 1.0 && < 1.2,       filepath >= 1.1 && < 1.4,       hashable == 1.1.*,@@ -176,12 +118,13 @@       Build-Depends:   intern >= 0.8 && < 1.0     Hs-Source-Dirs: src/+   Other-Modules:  Swish.RDF.Formatter.Internal     Exposed-Modules:       Data.Interned.URI-      Data.LookupMap       Data.Ord.Partial       Data.String.ShowLines+      Network.URI.Ord       Swish       Swish.Commands       Swish.Datatype@@ -250,7 +193,8 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,+      base,+      containers,       HUnit == 1.2.*,       swish @@ -264,9 +208,10 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      semigroups >= 0.5 && < 0.9,+      base,+      containers,+      HUnit,+      semigroups,       swish  Test-Suite test-graph@@ -279,8 +224,9 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,+      base,+      containers, +      HUnit,       swish  Test-Suite test-nt@@ -293,10 +239,11 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,+      base,+      containers,+      HUnit,       swish,-      text == 0.11.*+      text  Test-Suite test-n3parser    type:       exitcode-stdio-1.0@@ -308,11 +255,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-n3formatter    type:       exitcode-stdio-1.0@@ -324,11 +272,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-rdfdatatypexsdinteger    type:       exitcode-stdio-1.0@@ -340,11 +289,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-rdfgraph    type:       exitcode-stdio-1.0@@ -356,13 +306,14 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,-      old-locale == 1.0.*,+      base,+      containers,+      HUnit,+      network,+      old-locale,       swish,-      text == 0.11.*,-      time >= 1.1 && < 1.5+      text,+      time  Test-Suite test-rdfproofcontext    type:       exitcode-stdio-1.0@@ -374,11 +325,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-rdfproof    type:       exitcode-stdio-1.0@@ -390,11 +342,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-rdfquery    type:       exitcode-stdio-1.0@@ -406,11 +359,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-rdfruleset    type:       exitcode-stdio-1.0@@ -422,11 +376,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text  Test-Suite test-varbinding    type:       exitcode-stdio-1.0@@ -438,22 +393,9 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      swish--Test-Suite test-lookupmap-   type:       exitcode-stdio-1.0-   Hs-Source-Dirs: tests/-   Main-Is:        LookupMapTest.hs-   Other-Modules:  TestHelpers--   ghc-options:-      -Wall -fno-warn-orphans--   Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,+      base,+      containers,+      HUnit,       swish  Test-Suite test-qname@@ -466,11 +408,12 @@       -Wall -fno-warn-orphans     Build-Depends:-      base >=3 && < 5,-      HUnit == 1.2.*,-      network >= 2.2 && < 2.4,+      base,+      containers,+      HUnit,+      network,       swish,-      text == 0.11.*+      text   -- we do not have the data files to run this test  Executable         SwishTest@@ -505,5 +448,5 @@       ghc-prof-options: -auto-all     Build-Depends:-      base >=3 && < 5,+      base,       swish

@@ -39,98 +39,14 @@     , namespaceXsdType     ) -import Data.LookupMap (mapFindMaybe)+import qualified Data.Map as M  import Test.HUnit     ( Test(TestCase,TestList)     , assertEqual     ) -import TestHelpers (runTestSuite-                   , testJust-                   , testEqv2)-----------------------------------------------------------------  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 ("testNothing:"++lab) (isNothing 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--testMaker :: (Show b, Eq b) => (a -> b) -> String -> String -> a -> a -> Test-testMaker conv l1 l2 x y =-  TestCase (assertEqual ("testEqual:" ++ l1 ++ ":" ++ l2) (conv x) (conv y))-  -testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test-testEqv = testMaker ListTest "Eqv"---}--testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test-testEqvEqv = testEqv2--- testEqvEqv = testMaker (ListTest . map ListTest) "EqvEqv"--{--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 = testMaker MaybeListTest "MaybeEqv"--}+import TestHelpers (runTestSuite, testJust)  ------------------------------------------------------------ --  Test finding built-in variable binding modifiers@@ -183,7 +99,7 @@  testRuleset01 :: Test testRuleset01 = testJust "testRuleset01" $-    mapFindMaybe scopeRDF rdfRulesetMap+    M.lookup scopeRDF rdfRulesetMap  testRulesetSuite :: Test testRulesetSuite = TestList

@@ -25,58 +25,14 @@ import Swish.GraphClass (Arc(..)) import Swish.GraphMem (LabelMem(..)) -import Swish.Utils.ListHelpers (equiv)- import Data.List.NonEmpty (fromList) -import Test.HUnit (Test(TestCase, TestList),-                   assertEqual, assertBool)+import Test.HUnit (Test(TestList))  import TestHelpers (runTestSuite                     , testEq, testNe+                   , testEqv, testNotEqv                     )-----------------------------------------------------------------  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

@@ -14,13 +14,6 @@ -- -------------------------------------------------------------------------------- -{- --Note: after changing the hash module the order and values of some-of the tests; I have not checked that the new ordering makes sense.---}- module Main where  import qualified Data.Foldable as F@@ -29,11 +22,11 @@       ( Test(TestCase,TestList,TestLabel),         assertEqual, assertBool ) -import Swish.GraphClass (Arc(..), LDGraph(..), Label(..))+import Swish.GraphClass (Arc(..), ArcSet, LDGraph(..), Label(..)) import Swish.GraphClass (arc, arcFromTriple, arcToTriple) import Swish.GraphMem import Swish.GraphMatch-      ( LabelMap, GenLabelMap(..), LabelEntry, +      ( LabelMap, GenLabelMap(..),          EquivalenceClass,         ScopedLabel(..), makeScopedLabel, makeScopedArc,         LabelIndex, nullLabelVal, emptyMap,@@ -43,17 +36,18 @@ 	, equivalenceClasses       ) -import Swish.Utils.ListHelpers (subset)--import Data.LookupMap (LookupEntryClass(..), makeLookupMap)+-- import Swish.Utils.ListHelpers (subset) -import TestHelpers (runTestSuite, testEq, testEqv)+import TestHelpers (runTestSuite, testEq)  import Data.List (sort, elemIndex) import Data.Maybe (fromJust) import Data.Ord (comparing) import Data.Word (Word32) +import qualified Data.Map as M+import qualified Data.Set as S+ default ( Int )  ------------------------------------------------------------@@ -70,44 +64,23 @@ base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"  ---------------------------------------------------------------  Set, get graph arcs as lists of triples---------------------------------------------------------------setArcsT :: (LDGraph lg lb) =>-            [(lb, lb, lb)] -> lg lb -> lg lb-setArcsT a g = setArcs g $ map arcFromTriple a--getArcsT :: (LDGraph lg lb) =>-            lg lb -> [(lb, lb, lb)]-getArcsT g = map arcToTriple $ getArcs g-----------------------------------------------------------------  Test class helper+--  Set, get graph arcs as sets of triples ------------------------------------------------------------ -testeq :: (Show a, Eq a) => String -> a -> a -> Test-testeq = testEq-{--testeq lab req got =-    TestCase ( assertEqual ("test"++lab) req got )--}+setArcsT :: (Ord lb, LDGraph lg lb) =>+            S.Set (lb, lb, lb) -> lg lb -> lg lb+setArcsT a g = setArcs g $ S.map arcFromTriple a -testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test-testeqv = testEqv-{--testeqv lab req got =-    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )--}+getArcsT :: (Ord lb, LDGraph lg lb) =>+            lg lb -> S.Set (lb, lb, lb)+getArcsT g = S.map arcToTriple $ getArcs g  ------------------------------------------------------------ --  Label map and entry creation helpers ------------------------------------------------------------  tstLabelMap :: (Label lb) => Word32 -> [(lb,LabelIndex)] -> LabelMap lb-tstLabelMap gen lvs = LabelMap gen (makeLookupMap $ makeEntries lvs)--makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb]-makeEntries = map newEntry+tstLabelMap gen = LabelMap gen . M.fromList  ------------------------------------------------------------ --  Graph helper function tests@@ -119,7 +92,7 @@ -- other tests still test this routine  testSelect :: String -> String -> String -> Test-testSelect lab = testeq ("Select"++lab )+testSelect lab = testEq ("Select"++lab )  isOne :: Int -> Bool isOne = (1 ==)@@ -144,10 +117,12 @@  -} --- subset+-- subset: hopefully can remove soon +{-+ testSubset :: String -> Bool -> [Int] -> [Int] -> Test-testSubset lab res l1s l2s = testeq ("Mapset"++lab ) res (l1s `subset` l2s)+testSubset lab res l1s l2s = testEq ("Mapset"++lab ) res (l1s `subset` l2s)  testSubsetSuite :: Test testSubsetSuite = TestList@@ -161,32 +136,34 @@     , testSubset "08" False [1,2,3]       []     ] +-}+ ------------------------------------------------------------ --  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 "Lab01" False (labelIsVar lab1f)+    , testEq "Lab02" True  (labelIsVar lab1v)+    , testEq "Lab03" False (labelIsVar lab2f)+    , testEq "Lab04" True  (labelIsVar lab2v) -    , testeq "Lab05" 39495998 (labelHash 1 lab1f)-    , testeq "Lab06" 45349309 (labelHash 1 lab1v)-    , testeq "Lab07" 39495997 (labelHash 1 lab2f)-    , testeq "Lab08" 45349310 (labelHash 1 lab2v)+    , testEq "Lab05" 39495998 (labelHash 1 lab1f)+    , testEq "Lab06" 45349309 (labelHash 1 lab1v)+    , testEq "Lab07" 39495997 (labelHash 1 lab2f)+    , testEq "Lab08" 45349310 (labelHash 1 lab2v)      -    , testeq "Lab09" "!lab1" (show lab1f)-    , testeq "Lab10" "?lab1" (show lab1v)-    , testeq "Lab11" "!lab2" (show lab2f)-    , testeq "Lab12" "?lab2" (show 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")+    , testEq "Lab13" "lab1" (getLocal lab1v)+    , testEq "Lab14" "lab2" (getLocal lab2v)+    , testEq "Lab15" lab1v  (makeLabel "lab1")+    , testEq "Lab16" lab2v  (makeLabel "lab2")     ]  ------------------------------------------------------------@@ -199,11 +176,8 @@ lab2f = LF "lab2" lab2v = LV "lab2" -gr1 :: GraphMem LabelMem-gr1 = GraphMem { arcs=[]::[Statement] }--ga1 :: [(LabelMem, LabelMem, LabelMem)]-ga1 =+ga1 :: S.Set (LabelMem, LabelMem, LabelMem)+ga1 = S.fromList     [     (lab1f,lab1f,lab1f),     (lab1v,lab1v,lab1v),@@ -222,10 +196,10 @@  gs4 :: Statement -> Bool gs4 (Arc _ _ (LV "lab2")) = True-gs4 (Arc _ _  _         ) = False+gs4 _                     = False -ga4 :: [(LabelMem, LabelMem, LabelMem)]-ga4 =+ga4 :: S.Set (LabelMem, LabelMem, LabelMem)+ga4 = S.fromList     [     (lab2v,lab2v,lab2v),     (lab1f,lab1f,lab2v),@@ -234,11 +208,8 @@     (lab1v,lab2f,lab2v)     ] -gr2 :: GraphMem LabelMem-gr2 = GraphMem { arcs=[]::[Statement] }--ga2 :: [(LabelMem, LabelMem, LabelMem)]-ga2 =+ga2 :: S.Set (LabelMem, LabelMem, LabelMem)+ga2 = S.fromList     [     (lab1f,lab1f,lab1f),     (lab1v,lab1v,lab1v),@@ -246,11 +217,8 @@     (lab2v,lab2v,lab2v)     ] -gr3 :: GraphMem LabelMem-gr3 = GraphMem { arcs=[]::[Statement] }--ga3 :: [(LabelMem, LabelMem, LabelMem)]-ga3 =+ga3 :: S.Set (LabelMem, LabelMem, LabelMem)+ga3 = S.fromList     [     (lab1f,lab1f,lab1v),     (lab1f,lab1f,lab2f),@@ -263,14 +231,14 @@     (lab1v,lab2f,lab2v)     ] -gl4 :: [LabelMem]-gl4 = [lab1f,lab1v,lab2f,lab2v]+gl4 :: S.Set LabelMem+gl4 = S.fromList [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+gr1a = setArcsT ga1 (GraphMem S.empty)+gr2a = setArcsT ga2 emptyGraph+gr3a = setArcsT ga3 emptyGraph gr4a = addGraphs gr2a gr3a gr4b = addGraphs gr3a gr2a gr4c = delete gr2a gr4a@@ -278,24 +246,26 @@ gr4e = extract gs4 gr4a gr4g = addGraphs gr2a gr4a -gl4f :: [LabelMem]+gl4f :: S.Set LabelMem gl4f = labels gr4a +{- gr4ee :: [Bool]-gr4ee = map gs4 (getArcs gr4a)+gr4ee = map gs4 $ S.toList (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)+    [ testEq "Graph01" ga1 (getArcsT gr1a)+    , testEq "Graph01" ga2 (getArcsT gr2a)+    , testEq "Graph03" ga3 (getArcsT gr3a)+    , testEq "Graph04" ga1 (getArcsT gr4a)+    , testEq "Graph05" ga1 (getArcsT gr4b)+    , testEq "Graph06" ga3 (getArcsT gr4c)+    , testEq "Graph07" ga2 (getArcsT gr4d)+    , testEq "Graph08" ga4 (getArcsT gr4e)+    , testEq "Graph09" gl4 gl4f+    , testEq "Graph10" ga1 (getArcsT gr4g)     ]  ------------------------------------------------------------@@ -530,28 +500,28 @@ -- showLabelMap :: (Label lb) => LabelMap lb -> String  testShowLabelMap :: Test-testShowLabelMap = testeq "showLabelMap" showMap (show lmap)+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)"+                  "    (!,(4,4))\n"+++                  "    (!o1,(1,1))\n"+++                  "    (!o2,(2,2))\n"+++                  "    (!o3,(3,3))\n"+++                  "    (!s1,(1,1))\n"+++                  "    (!s2,(2,2))\n"+++                  "    (!s3,(3,3))"  testMapLabelHash00 :: Test-testMapLabelHash00 = testeq "mapLabelHash00" showMap (show lmap1)+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)"+                  "    (!,(4,4))\n"+++                  "    (!o1,(1,1))\n"+++                  "    (!o2,(2,2))\n"+++                  "    (!o3,(3,3))\n"+++                  "    (!s1,(1,1))\n"+++                  "    (!s2,(5,22))\n"+++                  "    (!s3,(3,3))"  -- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex @@ -560,39 +530,39 @@   [ 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 "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 "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 "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 )+  , 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 )        ] @@ -621,58 +591,56 @@ t21 = arc b3 p2 b4 t22 = arc b4 p3 o1 -as1, as2, as4, as5, as6 :: [Statement]-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]+as1, as2, as4, as5, as6 :: S.Set Statement+as1 = S.singleton t01+as2 = S.fromList [t01,t02,t03,t04,t05,t06]+as4 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12]+as5 = S.fromList [t01,t02,t03,t04,t05,t06,t20,t21,t22]+as6 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] --- graphLabels :: (Label lb) => [Arc lb] -> [lb]+-- graphLabels :: (Label lb) => ArcSet lb -> S.Set lb -ls4 :: [LabelMem]-ls4 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]+-- not clear both the 'raw' and 'string' versions are still needed. +ls4, glas4 :: S.Set LabelMem+ls4   = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]+glas4 = graphLabels as4+ testGraphLabels04, testGraphLabels14 :: Test-testGraphLabels04 = testeqv "GraphLabels04" ls4 (graphLabels as4)-testGraphLabels14 = testeq  "GraphLabels14" str (show (graphLabels as4))+testGraphLabels04 = testEq "GraphLabels04" ls4 glas4+testGraphLabels14 = testEq "GraphLabels14" str (show glas4)     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]"+      -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]"+      str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2]"+      -- str = show ls4 -ls5 :: [LabelMem]-ls5 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]+ls5, glas5 :: S.Set LabelMem+ls5   = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]+glas5 = graphLabels as5  testGraphLabels05, testGraphLabels15 :: Test-testGraphLabels05 = testeqv "GraphLabels05" ls5 (graphLabels as5)-testGraphLabels15 = testeq  "GraphLabels15" str (show (graphLabels as5))+testGraphLabels05 = testEq "GraphLabels05" ls5 glas5+testGraphLabels15 = testEq "GraphLabels15" str (show glas5)     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]"+      -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]"+      str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b3,?b4]"+      -- str = show ls5 -ls6 :: [LabelMem]-ls6 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]+ls6, glas6 :: S.Set LabelMem+ls6   = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]+glas6 = graphLabels as6  testGraphLabels06, testGraphLabels16 :: Test-testGraphLabels06 = testeqv "GraphLabels05" ls6 (graphLabels as6)-testGraphLabels16 = testeq  "GraphLabels16" str (show (graphLabels as6))+testGraphLabels06 = testEq "GraphLabels05" ls6 glas6+testGraphLabels16 = testEq "GraphLabels16" str (show glas6)     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]"+      -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"+++      --       ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]"+      str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2,?b3,?b4]"+      -- str = show ls6  -- 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))]--}- bhash :: Word32 bhash = 23 @@ -701,6 +669,7 @@ s2hash = 2720 s3hash = 2721 +lmap5 :: LabelMap LabelMem lmap5 = tstLabelMap 2          [           (b4,(1,bhash)),@@ -720,7 +689,7 @@         ]  testAssignLabelMap05 :: Test        -testAssignLabelMap05 = testeq "AssignLabels05" lmap5+testAssignLabelMap05 = testEq "AssignLabels05" lmap5                         (newGenerationMap $ assignLabelMap ls5 emptyMap)  lmap6 :: LabelMap LabelMem@@ -745,7 +714,7 @@         ]          testAssignLabelMap06 :: Test-testAssignLabelMap06 = testeq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)+testAssignLabelMap06 = testEq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)  lmapc :: LabelMap LabelMem lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)),@@ -767,8 +736,8 @@   , testAssignLabelMap05   , testAssignLabelMap06     -- implicitly tested elsewhere but included here for completeness-  , testeq "O16-identity" tOrder16 $ sort tOrder16-  , testeq "O16-compare"  tOrder16 $ sort [t01,t02,t03,t04,t05,t06]+  , testEq "O16-identity" tOrder16 $ sort tOrder16+  , testEq "O16-compare"  tOrder16 $ sort [t01,t02,t03,t04,t05,t06]   ]  ------------------------------------------------------------@@ -859,9 +828,9 @@  -- Compare graph as6 with self, in steps -as61, as62 :: [Arc (ScopedLabel LabelMem)]-as61 = map (makeScopedArc 1) as6-as62 = map (makeScopedArc 2) as6+as61, as62 :: ArcSet (ScopedLabel LabelMem)+as61 = S.map (makeScopedArc 1) as6+as62 = S.map (makeScopedArc 2) as6  eq1lmap :: LabelMap (ScopedLabel LabelMem) eq1lmap     = newGenerationMap $@@ -906,7 +875,7 @@             ]            testEqAssignMap01 :: Test              -testEqAssignMap01 = testeq "EqAssignMap01" eq1ltst eq1lmap+testEqAssignMap01 = testEq "EqAssignMap01" eq1ltst eq1lmap  eq1hs1, eq1hs2 :: [Arc (ScopedLabel LabelMem)] eq1hs1      = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1]@@ -956,13 +925,13 @@                             ]  testEqNewLabelMap07 :: Test-testEqNewLabelMap07 = testeq "EqNewLabelMap07" eq1ltst'' eq1lmap''+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+as41, as42 :: ArcSet (ScopedLabel LabelMem)+as41 = S.map (makeScopedArc 1) as4+as42 = S.map (makeScopedArc 2) as4  eq2lmap :: LabelMap (ScopedLabel LabelMem) eq2lmap     = newGenerationMap $@@ -1003,7 +972,7 @@           ]  testEqAssignMap21 :: Test-testEqAssignMap21 = testeq "EqAssignMap21" eq2ltst eq2lmap+testEqAssignMap21 = testEq "EqAssignMap21" eq2ltst eq2lmap  eq2hs1, eq2hs2 :: [Arc (ScopedLabel LabelMem)] eq2hs1      = [t10_1,t11_1,t12_1]@@ -1047,21 +1016,21 @@                             ]  testEqNewLabelMap27 :: Test-testEqNewLabelMap27 = testeq "EqNewLabelMap27" eq2ltst'' eq2lmap''+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+as11, as22 :: ArcSet (ScopedLabel LabelMem)+as11 = S.map (makeScopedArc 1) as1+as22 = S.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]+eq3hs1, eq3hs2 :: ArcSet (ScopedLabel LabelMem)+eq3hs1   = S.singleton t01_1+eq3hs2   = S.fromList [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+testEqGraphMap31_1 = testEq "testEqGraphMap31_1" eq3hs1 as11+testEqGraphMap31_2 = testEq "testEqGraphMap31_2" eq3hs2 as22  eq3lmap :: LabelMap (ScopedLabel LabelMem) eq3lmap     = newGenerationMap $@@ -1087,13 +1056,13 @@     ]  testEqAssignMap32 :: Test    -testEqAssignMap32 = testeq "EqAssignMap32" eq3ltst eq3lmap+testEqAssignMap32 = testEq "EqAssignMap32" eq3ltst eq3lmap  type EquivClass = EquivalenceClass (ScopedLabel LabelMem) type EquivArgs  = ((Word32, Word32), [ScopedLabel LabelMem])  ec31 :: [EquivClass]-ec31     = equivalenceClasses eq3lmap (graphLabels as11)+ec31 = equivalenceClasses eq3lmap (graphLabels as11)  ec31test :: [EquivArgs] ec31test =@@ -1120,8 +1089,8 @@     ]    testEquivClass33_1, testEquivClass33_2 :: Test-testEquivClass33_1 = testeq "EquivClass33_1" ec31test ec31-testEquivClass33_2 = testeq "EquivClass33_2" ec32test ec32+testEquivClass33_1 = testEq "EquivClass33_1" ec31test ec31+testEquivClass33_2 = testEq "EquivClass33_2" ec32test ec32  {- as pairSOrt is no-longer exported need to check this code gets tested @@ -1142,7 +1111,7 @@     , ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) )     ] -testEquivClass33_3 = testeq "EquivClass33_3" ec3test ec3pairs+testEquivClass33_3 = testEq "EquivClass33_3" ec3test ec3pairs -}  {- pairSort is no longer exported@@ -1168,21 +1137,21 @@     , (p1_2,(1,142385))     , (s1_2,(1,142577))     ]--- testEqAssignMap34 = testeq "EqAssignMap34" (Just eq3ltst1) eq3lmap1--- testEqAssignMap34 = testeq "EqAssignMap34" Nothing eq3lmap1+-- testEqAssignMap34 = testEq "EqAssignMap34" (Just eq3ltst1) eq3lmap1+-- testEqAssignMap34 = testEq "EqAssignMap34" Nothing eq3lmap1  {- pairSort is not exported testEqAssignMap34 :: Test-testEqAssignMap34 = testeq "EqAssignMap34" False (fst eq3lmap1)+testEqAssignMap34 = testEq "EqAssignMap34" False (fst eq3lmap1) -}  {- eq3rc1      = reclassify eq3hs1 eq3lmap eq3rctst1   = []-testEqReclassify35_1 = testeqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1+testEqReclassify35_1 = testEqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1 eq3rc2      = reclassify eq3hs2 eq3lmap eq3rctst2   = []-testEqReclassify35_2 = testeqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2+testEqReclassify35_2 = testEqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2 -}  @@ -1213,15 +1182,18 @@ testGraphEq lab eq gg1 gg2 =     TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) ) +toG :: [Statement] -> GraphMem LabelMem+toG stmts = GraphMem { arcs = S.fromList stmts }+ 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] }+g1 = toG [t01]+g2 = toG [t01,t02,t03,t04,t05,t06]+g3 = toG [t06,t05,t04,t03,t02,t01]+g4 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12]+g5 = toG [t01,t02,t03,t04,t05,t06,t20,t21,t22]+g6 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]+g7 = toG [t01,t02]+g8 = toG [t02,t01]  glist :: [(String, GraphMem LabelMem)] glist =@@ -1551,8 +1523,8 @@  -- -arcsToGraph :: [Arc a] -> GraphMem a-arcsToGraph as = GraphMem { arcs = as }+arcsToGraph :: (Ord a) => [Arc a] -> GraphMem a+arcsToGraph as = GraphMem { arcs = S.fromList as }  -- Very simple case @@ -1857,8 +1829,8 @@ allTests :: Test allTests = TestList   [ -- testSelectSuite-    testSubsetSuite-  , testLabSuite+    -- testSubsetSuite+    testLabSuite   , testGraphSuite   , testLabelEqSuite   , testLabelOrdSuite

@@ -1,407 +0,0 @@-{-# 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 Data.LookupMap-    ( LookupEntryClass(..), LookupMap(..)-    , makeLookupMap-    , reverseLookupMap-    , mapFind, mapContains-    , mapReplace, mapReplaceAll, mapReplaceMap-    , mapAdd, mapAddIfNew-    , mapDelete, mapDeleteAll-    , mapEq, mapKeys, mapVals-    , mapMerge-    )--import Data.List ( sort )--import Test.HUnit ( Test(TestList) )--import TestHelpers (runTestSuite-                    , testEq-                    , testEqv-                    )-  ----------------------------------------------------------------  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 = testEq-{--testeq lab req got =-    TestCase ( assertEqual ("test"++lab) req got )--}--testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test-testeqv = testEqv-{--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--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 = mapReplace lm22 (newEntry (1,"aaa35"))-lm36 = mapReplace lm22 (newEntry (4,"ddd36"))--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 ""-  , 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) (nodeTest l1 l2) m1 m2-      | (l1,m1) <- maplist , (l2,m2) <- maplist ]-    where-    testLab l1 l2 = l1 ++ "-" ++ l2-    nodeTest  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]--}--lm102 = mapAdd (mapAdd (newMap []) (newEntry (1,"aaa"))) $ newEntry (3,"ccc")-lm103 = mapAdd (mapAdd (newMap []) (newEntry (2,"bbb"))) $ newEntry (4,"ddd")-lm104 = mapAdd (mapAdd (newMap []) (newEntry (2,"bbb"))) $ newEntry (3,"ccc")--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 "101" lm101 [(4,"ddd"),(3,"ccc"),(2,"bbb"),(1,"aaa")]-  , 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")]-  ] -  ----------------------------------------------------------------  All tests---------------------------------------------------------------allTests :: Test-allTests = TestList-  [ testLookupMapSuite-  , testRevLookupMapSuite-  , testMapKeysSuite-  , testMapValsSuite-  , testMapEqSuite-  , mapMergeSuite-  ]--main :: IO ()-main = runTestSuite allTests--{--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------------------------------------------------------------------------------------

@@ -19,7 +19,7 @@ module Main where  import Swish.GraphClass (Arc, arc)-import Swish.Namespace (Namespace, makeNamespace, makeNSScopedName, namespaceToBuilder)+import Swish.Namespace (Namespace, makeNamespace, getNamespaceTuple, makeNSScopedName, namespaceToBuilder) import Swish.QName (LName)  import Swish.RDF.Formatter.N3 (formatGraphAsLazyText, formatGraphDiag)@@ -30,14 +30,11 @@     , RDFLabel(..), ToRDFLabel     , NSGraph(..)     , NamespaceMap-    , LookupFormula(..)     , emptyRDFGraph, toRDFGraph, toRDFTriple     , resRdfType, resRdfFirst, resRdfRest, resRdfNil     , resOwlSameAs     ) -import Data.LookupMap (LookupMap(..), emptyLookupMap, makeLookupMap)- import Swish.RDF.Vocabulary (toLangTag, namespaceRDF, namespaceXSD)  import Network.URI (URI, parseURI)@@ -47,6 +44,8 @@  import Data.String (IsString(..)) +import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -183,7 +182,7 @@ t07 = arc s3 p2 l3  nslist :: NamespaceMap-nslist = makeLookupMap+nslist = M.fromList $ map getNamespaceTuple     [ base1     , base2     , base3@@ -191,10 +190,11 @@     ]  g1np :: RDFGraph-g1np = emptyRDFGraph { namespaces = makeLookupMap [base1], statements = [t01] }+g1np = emptyRDFGraph { namespaces = uncurry M.singleton (getNamespaceTuple base1) +                     , statements = S.singleton t01 }  toGraph :: [Arc RDFLabel] -> RDFGraph-toGraph arcs = (toRDFGraph arcs) {namespaces = nslist}+toGraph arcs = (toRDFGraph (S.fromList arcs)) {namespaces = nslist}  g1, g1b1, g1b3, g1a1, g1l1, g1l2 :: RDFGraph g1   = toGraph [t01]@@ -207,44 +207,39 @@ {- g1f1 = NSGraph         { namespaces = nslist-        , formulae   = formo1g1+        , formulae   = M.singleton o1 (Formula o1g1)         , statements = [f01]         }     where         f01      = arc s1 p1 o1-        formo1g1 = LookupMap [Formula o1 g1] -}  g1f2, g1f3 :: RDFGraph g1f2 = NSGraph         { namespaces = nslist-        , formulae   = formb2g1-        , statements = [f02]+        , formulae   = M.singleton b2 g1 -- $ Formula b2 g1+        , statements = S.singleton $ arc s1 p1 b2         }-    where-        f02 = arc s1 p1 b2-        formb2g1 = LookupMap [Formula b2 g1]  g1f3 = NSGraph         { namespaces = nslist-        , formulae   = formb3g1f2-        , statements = [f02]+        , formulae   = M.singleton b3 g1f2 -- $ Formula b3 g1f2+        , statements = S.singleton $ arc s1 p1 b3         }-    where-        f02 = arc s1 p1 b3-        formb3g1f2 = LookupMap [Formula b3 g1f2]  g1fu1 :: RDFGraph g1fu1 =   mempty-  { namespaces = makeLookupMap [basem, makeNamespace Nothing (toURI "file:///home/swish/photos/")]-  , statements = [arc sf meDepicts meMe, arc sf meHasURN su]+  { namespaces = +      M.fromList $ map getNamespaceTuple+        [basem, makeNamespace Nothing (toURI "file:///home/swish/photos/")]+  , statements = S.fromList [arc sf meDepicts meMe, arc sf meHasURN su]   }    ----  g2, g3, g4, g5, g6, g7 :: RDFGraph-g2 = toRDFGraph [t01,t02,t03]+g2 = toRDFGraph $ S.fromList [t01,t02,t03] g3 = toGraph [t01,t04] g4 = toGraph [t01,t05] g5 = toGraph [t01,t02,t03,t04,t05]@@ -440,22 +435,22 @@ x7 :: RDFGraph x7 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 g2]-        , statements = [arc b1 p2 f2]+        , formulae   = M.singleton b1 g2 -- $ Formula b1 g2+        , statements = S.singleton $ arc b1 p2 f2         }  x8 :: RDFGraph x8 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula f1 g2]-        , statements = [arc f1 p2 f2]+        , formulae   = M.singleton f1 g2 -- $ Formula f1 g2+        , statements = S.singleton $ arc f1 p2 f2         }  x9 :: RDFGraph x9 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula f1 g1]-        , statements = [arc f1 p2 f2]+        , formulae   = M.singleton f1 g1 -- $ Formula f1 g1+        , statements = S.singleton $ arc f1 p2 f2         }          --  Test allocation of bnodes carries over a nested formula@@ -463,8 +458,9 @@ x12, x12fg :: RDFGraph x12    = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b2 x12fg]-        , statements = [ arc s1 p1 b1+        , formulae   = M.singleton b2 x12fg -- $ Formula b2 x12fg+        , statements = S.fromList +	  	       [ arc s1 p1 b1                        , arc b1 p1 o1                        , arc b2 p2 f2                        , arc s3 p3 b3@@ -472,7 +468,8 @@                        ]         } -x12fg  = toRDFGraph [ arc s2 p2 b4+x12fg  = toRDFGraph $ S.fromList+                    [ arc s2 p2 b4                     , arc b4 p2 o2                     ]         @@ -643,22 +640,22 @@  graph_b1, graph_b1rev, graph_b2, graph_b2rev, graph_b3,    graph_b4, graph_b5 :: RDFGraph-graph_b1    = toRDFGraph [arc s1 p1 b1]-graph_b1rev = toRDFGraph [arc b1 p1 o1]-graph_b2    = toRDFGraph [arc s1 p1 b1,+graph_b1    = toRDFGraph $ S.singleton $ arc s1 p1 b1+graph_b1rev = toRDFGraph $ S.singleton $ arc b1 p1 o1+graph_b2    = toRDFGraph $ S.fromList [arc s1 p1 b1,                           arc b1 p2 l1,                           arc b1 o2 o3]-graph_b2rev = toRDFGraph [arc b1 p2 l1,+graph_b2rev = toRDFGraph $ S.fromList [arc b1 p2 l1,                           arc b1 o2 o3,                           arc b1 p1 o1]-graph_b3    = toRDFGraph [arc s1 p1 b1,+graph_b3    = toRDFGraph $ S.fromList [arc s1 p1 b1,                           arc b1 p2 l2,                           arc b1 o2 o3,                           arc s1 p2 b2,                           arc s2 p2 o2]-graph_b4    = toRDFGraph [arc b1 resRdfType o1,+graph_b4    = toRDFGraph $ S.fromList [arc b1 resRdfType o1,                           arc b2 resRdfType o2]-graph_b5    = toRDFGraph [arc b1 resRdfType o1,+graph_b5    = toRDFGraph $ S.fromList [arc b1 resRdfType o1,                           arc b2 p2 o2,                           arc b3 resRdfType o3] @@ -683,9 +680,12 @@              ]   {-                    gtmp = toRDFGraph arcs-  in gtmp { namespaces = mapAdd (namespaces gtmp) (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") }+  in gtmp { namespaces = +           M.insert (Just "xsd") ("http://www.w3.org/2001/XMLSchema#")+                    (namespaces gtmp)+          }   -}-  in toRDFGraph arcs+  in toRDFGraph $ S.fromList arcs     graph_l4 = toGraph [ toRDFTriple s1 p1 ("A string with \"quotes\"" :: RDFLabel)                    , toRDFTriple s2 p2 (TypedLit "A typed string with \"quotes\"" (fromString "urn:a#b"))@@ -711,7 +711,7 @@ diagTest lab gr out =     TestList       [ TestCase ( assertEqual ("diag:text:"++lab) out resTxt )-      , TestCase ( assertEqual ("diag:map:"++lab) emptyLookupMap nmap )+      , TestCase ( assertEqual ("diag:map:"++lab) M.empty nmap )       , TestCase ( assertEqual ("diag:gen:"++lab) 0 ngen )       , TestCase ( assertEqual ("diag:trc:"++lab) [] trc )       ]@@ -829,8 +829,8 @@ simpleN3Graph_g1_fu1 :: B.Builder simpleN3Graph_g1_fu1 =   mconcat-  [ "@prefix me: <http://example.com/ns#> .\n"-  , "@prefix : <file:///home/swish/photos/> .\n"+  [ "@prefix : <file:///home/swish/photos/> .\n"+  , "@prefix me: <http://example.com/ns#> .\n"   -- , ":me.png me:depicts me:me ;\n"   , "<file:///home/swish/photos/me.png> me:depicts me:me ;\n"   , "     me:hasURN <urn:one:two:3.14> .\n"@@ -915,18 +915,18 @@  simpleN3Graph_b2 :: B.Builder simpleN3Graph_b2 =-  commonPrefixesN [2,1,0] `mappend`+  commonPrefixesN [0,1,2] `mappend`   "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n     base2:p2 \"l1\"\n] .\n"  simpleN3Graph_b2rev :: B.Builder simpleN3Graph_b2rev =-  commonPrefixesN [0,2,1] `mappend`+  commonPrefixesN [0,1,2] `mappend`   "[\n base1:p1 base1:o1 ;\n     base2:o2 base3:o3 ;\n     base2:p2 \"l1\"\n] .\n"  simpleN3Graph_b3 :: B.Builder simpleN3Graph_b3 =   mconcat-  [ commonPrefixesN [2,1,0]+  [ commonPrefixesN [0,1,2]   , "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" ]@@ -934,14 +934,14 @@ simpleN3Graph_b4 :: B.Builder simpleN3Graph_b4 =   mconcat-  [ commonPrefixesN [1,0,4]+  [ commonPrefixesN [0,1,4]   , "[\n a base1:o1\n] .\n"   , "[\n a base2:o2\n] .\n" ]  simpleN3Graph_b5 :: B.Builder simpleN3Graph_b5 =   mconcat-  [ commonPrefixesN [2,1,0,4]+  [ commonPrefixesN [0,1,2,4]   , "[\n a base1:o1\n] .\n"   , "[\n base2:p2 base2:o2\n] .\n"   , "[\n a base3:o3\n] .\n" ]@@ -963,16 +963,11 @@ simpleN3Graph_l3 :: B.Builder simpleN3Graph_l3 =   mconcat-  [ commonPrefixesN [5,0]+  [ commonPrefixesN [0, 5]   , "\n" -- TODO: why do we need this newline?-  , "base1:s1 base1:p1 \"2.34E1\"^^xsd:float,\n"-  , "     -2.304e-108,\n" -  , "     12,     true .\n" ]--{--  "                  -2.304e-108,\n" ++ -  "                  12,                  true .\n"--}+  , "base1:s1 base1:p1 -2.304e-108,\n"+  , "     12,\n" +  , "     \"2.34E1\"^^xsd:float,     true .\n" ]  simpleN3Graph_l4 :: B.Builder simpleN3Graph_l4 =

@@ -20,12 +20,11 @@  import Swish.GraphClass (Arc, arc)  import Swish.Namespace (-  Namespace, makeNamespace, getNamespaceURI+  Namespace, makeNamespace, getNamespaceURI, getNamespaceTuple   , ScopedName   , makeScopedName   , makeNSScopedName   , nullScopedName-  -- , makeUriScopedName   , namespaceToBuilder   ) import Swish.QName (QName, qnameFromURI)@@ -39,8 +38,7 @@     )  import Swish.RDF.Graph-    ( RDFGraph, RDFLabel(..), NSGraph(..)-    , LookupFormula(..)+    ( RDFGraph, RDFLabel(..), NSGraph(..), NamespaceMap     , emptyRDFGraph, toRDFGraph     , resRdfType, resRdfFirst, resRdfRest, resRdfNil     , resOwlSameAs, resLogImplies@@ -56,8 +54,6 @@     , xsdDouble      ) -import Data.LookupMap (LookupMap(..))- import Test.HUnit (Test(TestCase,TestList), assertEqual)  import Network.URI (URI, nullURI, parseURIReference)@@ -66,6 +62,8 @@ import Data.Maybe (fromJust, fromMaybe) import Data.List (intercalate) +import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -353,8 +351,8 @@ makeNewPrefixNamespace (pre,ns) = makeNamespace (Just pre) (getNamespaceURI ns)  dg1, dg2, dg3 :: RDFGraph-dg1 = toRDFGraph [arc ds1 dp1 do1]-dg2 = toRDFGraph+dg1 = toRDFGraph $ S.singleton $ arc ds1 dp1 do1+dg2 = toRDFGraph $ S.fromList       [ arc xa1 xb1 xc1       , arc xa2 xb2 xc2       , arc xa3 xb3 xc3@@ -384,26 +382,15 @@     xc5 = mUN ns5 "c5"  dg3 = -- TODO: add in prefixes ?-  toRDFGraph [ arc (Res "file:///home/swish/photos/myphoto") (Res "http://example.com/ns#photoOf") (Res "http://example.com/ns#me")]+  toRDFGraph $ S.singleton $ arc (Res "file:///home/swish/photos/myphoto") (Res "http://example.com/ns#photoOf") (Res "http://example.com/ns#me")   -nslist, xnslist :: LookupMap Namespace-nslist = LookupMap $ map makeNewPrefixNamespace-    [ ("base1",base1)-    , ("base2",base2)-    , ("base3",base3)-    , ("base4",base4)-    ]-xnslist = LookupMap $ map makeNewPrefixNamespace-    [ ("base1",base1)-    , ("base2",base2)-    , ("base3",base3)-    , ("base4",base4)-    , ("xsd", xsdNS)-    ]+nslist, xnslist :: NamespaceMap+nslist = M.fromList $ map getNamespaceTuple [base1, base2, base3, base4]+xnslist = (\(a,b) -> M.insert a b nslist) $ getNamespaceTuple xsdNS  toGraph :: [Arc RDFLabel] -> RDFGraph toGraph stmts = mempty { namespaces = nslist-                        , statements = stmts+                        , statements = S.fromList stmts                         }  g1 :: RDFGraph@@ -649,8 +636,8 @@ x7 :: RDFGraph x7    = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 g2]-        , statements = [tx701]+        , formulae   = M.singleton b1 g2 -- $ Formula b1 g2+        , statements = S.singleton tx701         }  tx801 :: Arc RDFLabel@@ -659,15 +646,15 @@ x8 :: RDFGraph x8    = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula f1 g2]-        , statements = [tx801]+        , formulae   = M.singleton f1 g2 -- $ Formula f1 g2+        , statements = S.singleton tx801         }  x9 :: RDFGraph x9    = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula f1 g1]-        , statements = [tx801]+        , formulae   = M.singleton f1 g1 -- $ Formula f1 g1+        , statements = S.singleton tx801         }  --  Test allocation of bnodes carries over a nested formula@@ -683,20 +670,20 @@ tx1212 = arc b4 p2 o2  x12fg :: RDFGraph-x12fg  = mempty { statements = [tx1211,tx1212] }+x12fg  = mempty { statements = S.fromList [tx1211,tx1212] } {- x12fg  = NSGraph         { namespaces = emptyNamespaceMap         , formulae   = emptyFormulaMap-        , statements = [tx1211,tx1212]+        , statements = S.fromList [tx1211,tx1212]         } -}          x12 :: RDFGraph x12    = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b2 x12fg]-        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]+        , formulae   = M.singleton b2 x12fg -- $ Formula b2 x12fg+        , statements = S.fromList [tx1201,tx1202,tx1203,tx1204,tx1205]         }  --  List of simple anon nodes@@ -808,8 +795,7 @@                tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]  kg1 :: RDFGraph-kg1 = toRDFGraph-      [ arc b a c ]+kg1 = toRDFGraph $ S.singleton $ arc b a c   where     -- the document base is set to file:///dev/null to begin with     mUN = Res . makeNSScopedName dbase@@ -1265,7 +1251,7 @@ lit_g4 :: RDFGraph lit_g4 = mempty {   namespaces = xnslist-  , statements = [+  , statements = S.fromList [     arc s1 p1 b1     , arc b1 resRdfFirst bTrue     , arc b1 resRdfRest  b2

@@ -35,11 +35,12 @@     ( Test(TestCase,TestList)     , assertEqual ) -import qualified Data.Text.Lazy as T- import Data.Maybe (fromJust) import TestHelpers (runTestSuite) +import qualified Data.Set as S+import qualified Data.Text.Lazy as T+ ------------------------------------------------------------ --  Parser tests ------------------------------------------------------------@@ -100,10 +101,10 @@ ------------------------------------------------------------  s1, p1, p2, o1 :: RDFLabel-s1 = Res $ "urn:b#s1" -- rely on IsString to convert to ScopedName-p1 = Res $ "urn:b#p1"-p2 = Res $ "http://example.com/pred2"-o1 = Res $ "urn:b#o1"+s1 = Res "urn:b#s1" -- rely on IsString to convert to ScopedName+p1 = Res "urn:b#p1"+p2 = Res "http://example.com/pred2"+o1 = Res "urn:b#o1" {- s1 = Res $ makeURIScopedName "urn:b#s1" p1 = Res $ makeURIScopedName "urn:b#p1"@@ -133,10 +134,10 @@ ------------------------------------------------------------  g0 :: RDFGraph-g0 = toRDFGraph []+g0 = toRDFGraph S.empty  mkGr1 :: RDFLabel -> RDFLabel -> RDFLabel -> RDFGraph-mkGr1 s p o = toRDFGraph [arc s p o]+mkGr1 s p o = toRDFGraph $ S.singleton $ arc s p o  g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11, g12 :: RDFGraph g1 = mkGr1 s1 p1 o1@@ -153,7 +154,7 @@ g12 = mkGr1 s1 p1 l4  gm1 :: RDFGraph-gm1 = toRDFGraph [arc b2 p2 b1, arc b2 p1 o1]+gm1 = toRDFGraph $ S.fromList [arc b2 p2 b1, arc b2 p1 o1]  ------------------------------------------------------------ --  Input documents

@@ -203,7 +203,7 @@ ------------------------------------------------------------  testMaybeQNameEq :: String -> Bool -> Maybe QName -> Maybe QName -> Test-testMaybeQNameEq lbl eq n1 n2 = testCompareEq "MaybeQName" lbl eq n1 n2+testMaybeQNameEq = testCompareEq "MaybeQName"  testMaybeQNameEqSuite :: Test testMaybeQNameEqSuite = 

@@ -51,22 +51,20 @@  import Swish.RDF.Vocabulary (namespaceDefault, namespaceRDF, namespaceRDFD, namespaceXSD) -import Data.LookupMap (LookupMap(..), mapFindMaybe)--import Test.HUnit-    ( Test(TestCase,TestList)-      , assertFailure-    )+import Data.List (intersperse)+import Data.Maybe (fromMaybe, fromJust)+import Data.Monoid (Monoid(..))  import Network.URI (URI, parseURI) -import Data.Monoid (Monoid(..))-import Data.Maybe (fromMaybe, fromJust)-import Data.List (intersperse)-+import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as B +import Test.HUnit+    ( Test(TestCase,TestList)+      , assertFailure+    ) import TestHelpers (runTestSuite                    , testEq, testElem, testEqv, testEqv2) @@ -916,7 +914,7 @@ diff03inp = multiInp "Diff" [(1, -111), (2, 222)]      diff01bwd :: [[B.Builder]]-diff01bwd =+diff01bwd =      [ [ "_:a a xsd_integer:Diff . "       , "_:a rdf:_1 \"-111\"^^xsd:integer . "       , "_:a rdf:_2 \"222\"^^xsd:integer . "@@ -928,7 +926,7 @@     ]  diff02bwd :: [[B.Builder]]-diff02bwd =+diff02bwd =      [ [ "_:a a xsd_integer:Diff . "       , "_:a rdf:_1 \"-111\"^^xsd:integer . "       , "_:a rdf:_2 \"222\"^^xsd:integer . "@@ -940,7 +938,7 @@     ]  diff03bwd :: [[B.Builder]]-diff03bwd =+diff03bwd =      [ [ "_:a a xsd_integer:Diff . "       , "_:a rdf:_1 \"-111\"^^xsd:integer . "       , "_:a rdf:_3 \"333\"^^xsd:integer . "@@ -1072,12 +1070,12 @@ --  Now the test cases that use the rules created above.  pvRule0, pvRule1 :: Maybe (Rule RDFGraph)-pvRule0 = mapFindMaybe+pvRule0 = M.lookup              (makeNSScopedName namespaceDefault "PassengerVehicle")-            (LookupMap pvRules)-pvRule1 = mapFindMaybe+            $ M.fromList $ map (\rl -> (ruleName rl, rl)) pvRules+pvRule1 = M.lookup             (makeNSScopedName namespaceDefault "PassengerVehicle1")-            (LookupMap pvRules)+            $ M.fromList $ map (\rl -> (ruleName rl, rl)) pvRules  pv01inp :: B.Builder pv01inp =

@@ -18,20 +18,16 @@  module Main where -import Swish.Namespace (Namespace, makeNamespace, getNamespaceURI, ScopedName, makeNSScopedName, nullScopedName)+import Swish.Namespace (Namespace, makeNamespace, getNamespaceURI, getNamespaceTuple, ScopedName, makeNSScopedName, nullScopedName) import Swish.QName (QName, qnameFromURI) -import Data.LookupMap (LookupMap(..), LookupEntryClass(..), mapFindMaybe)--import Swish.Utils.ListHelpers (equiv)--import Swish.GraphClass (Label(..), arc)+import Swish.GraphClass (Label(..), arc {- , arcToTriple -} )  import Swish.RDF.Graph   ( RDFTriple, toRDFTriple, fromRDFTriple-  , RDFGraph +  , RDFGraph, NamespaceMap, Formula   , RDFLabel(..), ToRDFLabel(..), FromRDFLabel(..)-  , NSGraph(..), Arc(..)+  , NSGraph(..)   , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral   , isDatatyped, isMemberProp   , isUri, isBlank, isQueryVar, makeBlank@@ -40,6 +36,7 @@   , getArcs, addArc   , remapLabels, remapLabelList   , setFormulae, getFormulae, setFormula, getFormula+  , fmapNSGraph   , newNode, newNodes )  import Swish.RDF.Vocabulary@@ -55,29 +52,35 @@   , xsdDate     ) -import qualified Data.Text as T--import qualified Data.Traversable as Traversable-import qualified Data.Foldable as Foldable+import Control.Arrow (first) -import Network.URI (URI, parseURI)-import Data.Monoid (Monoid(..)) import Data.List (elemIndex, intercalate) import Data.Maybe (fromJust, fromMaybe)+import Data.Monoid (Monoid(..)) import Data.Ord (comparing)+import Data.Time (UTCTime(..), Day, fromGregorian, buildTime) +import Network.URI (URI, parseURI)+ import System.Locale (defaultTimeLocale)-import Data.Time (UTCTime(..), Day, fromGregorian, buildTime) +import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Text as T++-- import qualified Data.Traversable as Traversable+import qualified Data.Foldable as Foldable+ import Test.HUnit     ( Test(TestCase,TestList,TestLabel)     , Assertion     , assertBool, assertEqual )  import TestHelpers ( runTestSuite-                     , testEq-                     , testCompare-                     , testCompareEq)+                   , testEq+                   , testEqv+                   , testCompare+                   , testCompareEq)  ------------------------------------------------------------ --  Test language tag comparisons@@ -690,24 +693,25 @@ nodeorder :: [String] nodeorder =   [ -    -- literals-    "l1"-  , "l11", "l12", "l10"-  , "l2", "l2gb", "l3"-  , "l5", "l6", "l4", "l8", "l9", "l7"-  -- URIs beginning with ':' and '<'  -  , "es1"-  , "us1"-  -- variables-  , "v1", "v2"   -- URIs+  "es1", "us1"   , "o1", "p1", "s1"   , "o2", "p2", "s2"   , "s4", "o4", "s6", "s7"   , "o3", "p3", "p4", "s3"+    -- literals+  , "l1"+    -- language literals+  , "l2", "l2gb", "l3"+    -- typed literals (we have repeats)+  , "l10", "l11", "l12"+  , "l4", "l5", "l6"+  , "l7", "l8", "l9"   -- blank nodes   , "b1", "b2", "b3", "b4"   , "o5", "s5", "s8"+  -- variables+  , "v1", "v2"   ]  testNodeOrdSuite :: Test@@ -847,26 +851,17 @@ makeNewPrefixNamespace :: (T.Text,Namespace) -> Namespace makeNewPrefixNamespace (pre,ns) = makeNamespace (Just pre) (getNamespaceURI ns) -nslist :: LookupMap Namespace-nslist = LookupMap $ map makeNewPrefixNamespace-    [ ("base1",base1)-    , ("base2",base2)-    , ("base3",base3)-    , ("base4",base4)-    ]+nslist :: NamespaceMap+nslist = M.fromList $ map getNamespaceTuple [base1,base2,base3,base4] -nslistalt :: LookupMap Namespace-nslistalt = LookupMap $ map makeNewPrefixNamespace-    [ ("altbase1",base1)-    , ("altbase2",base2)-    , ("altbase3",base3)-    ]+nslistalt :: NamespaceMap+nslistalt = M.fromList $ map (first (fmap (T.append "alt")) . getNamespaceTuple) [base1,base2,base3]  toGraph :: [RDFTriple] -> RDFGraph toGraph stmts = NSGraph         { namespaces = nslist         , formulae   = emptyFormulaMap-        , statements = stmts+        , statements = S.fromList stmts         }  g1, gt1 :: RDFGraph@@ -879,7 +874,7 @@ g1alt = NSGraph         { namespaces = nslistalt         , formulae   = emptyFormulaMap-        , statements = [t01]+        , statements = S.singleton t01         }  --  Construct version of g1 using just URIs@@ -893,14 +888,14 @@ tu01  = toRDFTriple uris1 urip1 urio1  g2arcs :: [String]-g2arcs = [-  "(base1:s1,base1:p1,base1:o1)", -  "(base2:s2,base1:p1,base2:o2)", -  "(base3:s3,base1:p1,base3:o3)", -  "(base1:s1,base1:p1,\"l1\")", -  "(base2:s2,base1:p1,\"l4\"^^base1:type1)", -  "(base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral)"-  ]+g2arcs = +    [ "(base1:s1,base1:p1,base1:o1)"+    , "(base1:s1,base1:p1,\"l1\")"+    , "(base2:s2,base1:p1,base2:o2)"+    , "(base2:s2,base1:p1,\"l4\"^^base1:type1)" +    , "(base3:s3,base1:p1,base3:o3)"+    , "(base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral)"+    ]    g2str :: String -> String g2str sp = @@ -985,9 +980,16 @@   , testGraphEq "g10-g10a" True g10 g10a   ] +{- showLabel :: RDFLabel -> String showLabel = (" " ++) . show+-} +-- QUS: are these tests useful, since all they test os the Monoid instance+-- of NSGraph (but maybe we do not explicitly test this elsewhere?)+--+-- The tests also used to check the Foldable instance of NSGraph but these+-- have been removed with the move to Set, rather than list, storage. testGraphFoldSuite :: Test testGraphFoldSuite = TestList   [ @@ -999,13 +1001,15 @@   , testEq "foldEg1"  g1                   (Foldable.fold [mempty,g1])   , testEq "foldg1g2" fg1g2                (Foldable.fold [g1,g2])   , testEq "foldg2g1" fg1g2                (Foldable.fold [g2,g1])+{- TODO: reinstate?   , testEq "foldMap0" ""                   (Foldable.foldMap showLabel (mempty::RDFGraph))   , testEq "foldMapg1"                         (concatMap showLabel [s1,p1,o1])     (Foldable.foldMap showLabel g1)   , testEq "foldMapg1f2"                    -    (concatMap showLabel $ s2 : concatMap (\(Arc s p o) -> [s,p,o]) g2Labels ++ [s1,p1,o1])+    (concatMap showLabel $ s2 : concatMap arcToTriple g2Labels ++ [s1,p1,o1])     (Foldable.foldMap showLabel g1f2)+-}   ]    ------------------------------------------------------------@@ -1015,9 +1019,8 @@ testFormulaLookup ::     String -> FormulaMap RDFLabel -> RDFLabel -> Maybe RDFGraph -> Test testFormulaLookup lab fs fl gr =-  testCompare "testFormulaLookup:" lab gr jfg-    where-      jfg = mapFindMaybe fl fs+  testCompare "testFormulaLookup:" lab gr $ M.lookup fl fs+  -- testCompare "testFormulaLookup:" lab gr $ fmap formGraph $ M.lookup fl fs  testMaybeEq :: (Eq a, Show a) => String -> Maybe a -> Maybe a -> Test testMaybeEq = testCompare "testMaybeEq:"@@ -1031,6 +1034,7 @@ g1f6 = setFormulae fm6 g1f1 g1f7 = setFormulae fm7 g1f1 + g1f1str, g1f2str :: String  g1f1str = @@ -1044,34 +1048,38 @@   "arcs: \n" ++   "    (base1:s1,base1:p1,base1:o1)" -lf11, lf22, lf23, lf24, lf25, lf27, lf33, lf36 :: LookupFormula RDFLabel RDFGraph+lf11, lf22, lf23, lf24, lf25, lf27, lf33, lf36 :: Formula RDFLabel lf11 = Formula s1 g1-lf22 = newEntry (s2,g2)-lf23 = newEntry (s2,g3)-lf24 = newEntry (s2,g4)-lf25 = newEntry (s2,g5)-lf27 = newEntry (s2,g7)-lf33 = newEntry (s3,g3)-lf36 = newEntry (s3,g6)+lf22 = Formula s2 g2+lf23 = Formula s2 g3+lf24 = Formula s2 g4+lf25 = Formula s2 g5+lf27 = Formula s2 g7+lf33 = Formula s3 g3+lf36 = Formula s3 g6  lf22str :: String lf22str =   "base2:s2 :- { \n" ++    "        (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,base2:o2)\n" ++    "        (base2:s2,base1:p1,\"l4\"^^base1:type1)\n" ++ +  "        (base3:s3,base1:p1,base3:o3)\n" ++   "        (base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral) }" -fm2, fm3, fm4, fm5, fm6, fm7 :: LookupMap (LookupFormula RDFLabel RDFGraph)-fm2  = LookupMap [lf22]-fm3  = LookupMap [lf11, lf22, lf33]-fm4  = LookupMap [lf11, lf23, lf33]-fm5  = LookupMap [lf11, lf24, lf36]-fm6  = LookupMap [lf11, lf25, lf36]-fm7  = LookupMap [lf11, lf27, lf36]+toFM :: [Formula RDFLabel] -> FormulaMap RDFLabel+toFM = M.fromList . map (\fm -> (formLabel fm, formGraph fm))+-- toFM = M.fromList . map (\fm -> (formLabel fm, fm)) +fm2, fm3, fm4, fm5, fm6, fm7 :: FormulaMap RDFLabel+fm2  = toFM [lf22]+fm3  = toFM [lf11, lf22, lf33]+fm4  = toFM [lf11, lf23, lf33]+fm5  = toFM [lf11, lf24, lf36]+fm6  = toFM [lf11, lf25, lf36]+fm7  = toFM [lf11, lf27, lf36]+ f1, f2, f3, f4, f5, f6, f7 :: FormulaMap RDFLabel f1   = getFormulae g1f1 f2   = getFormulae g1f2@@ -1225,17 +1233,17 @@   gt2f1a, gt2f1b, gt2f2a, gt2f2b,   gt2f3a, gt2f3b :: RDFGraph gt1f1a = gt1-gt1f1b = fmap translate g1f1+gt1f1b = fmapNSGraph translate g1f1 gt1f2a = setFormulae ftm2 gt1-gt1f2b = fmap translate g1f2+gt1f2b = fmapNSGraph translate g1f2 gt1f3a = setFormulae ftm3 gt1-gt1f3b = fmap translate g1f3+gt1f3b = fmapNSGraph translate g1f3 gt2f1a = gt2-gt2f1b = fmap translate g2f1+gt2f1b = fmapNSGraph translate g2f1 gt2f2a = setFormulae ftm2 gt2-gt2f2b = fmap translate g2f2+gt2f2b = fmapNSGraph translate g2f2 gt2f3a = setFormulae ftm3 gt2-gt2f3b = fmap translate g2f3+gt2f3b = fmapNSGraph translate g2f3  ft1, ft2, ft3, ft4, ft5, ft6 :: FormulaMap RDFLabel ft1 = getFormulae gt1f1b@@ -1246,11 +1254,13 @@ ft6 = getFormulae gt2f3b  ftm2, ftm3 :: FormulaMap RDFLabel-ftm2   = LookupMap [Formula st2 gt2]-ftm3   = LookupMap [Formula st1 gt1,Formula st2 gt2,Formula st3 gt3]+ftm2   = toFM [Formula st2 gt2]+ftm3   = toFM [Formula st1 gt1,Formula st2 gt2,Formula st3 gt3]  -- Monadic translate tests, using Maybe Monad +{- TODO: reinstate?+ gt1f1aM, gt1f1bM, gt1f2aM, gt1f2bM, gt1f5M :: Maybe RDFGraph gt1f1aM = Just gt1 gt1f1bM = Traversable.mapM translateM g1f1@@ -1261,6 +1271,7 @@ ft1M, ft2M :: FormulaMap RDFLabel ft1M = getFormulae $ fromMaybe (error "Unexpected: gt1f1bM") gt1f1bM ft2M = getFormulae $ fromMaybe (error "Unexpected: gt1f2bM") gt1f2bM+--}  testGraphTranslateSuite :: Test testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList@@ -1289,17 +1300,17 @@   , 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+--  , testGraphEqM "gt1f1aM-gt1f1bM" True gt1f1aM gt1f1bM      TODO: reinstate?+--  , 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   ]  ------------------------------------------------------------@@ -1316,15 +1327,12 @@    assertGrEquiv :: String -> RDFGraph -> RDFGraph -> Assertion assertGrEquiv lbl gg1 gg2 = -  assertGrHelper lbl gg1 gg2 $ getArcs gg1 `equiv` getArcs gg2+  assertGrHelper lbl gg1 gg2 $ getArcs gg1 == getArcs gg2  assertGrEq :: String -> RDFGraph -> RDFGraph -> Assertion assertGrEq lbl gg1 gg2 =    assertGrHelper lbl gg1 gg2 $ gg1 == 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 :: RDFTriple tm01 = arc s1  p1 b1@@ -1405,38 +1413,38 @@ gm5, gm55 :: RDFGraph gm5  = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 gm2]-        , statements = [tm01,tm02,tm03]+        , formulae   = toFM [Formula b1 gm2]+        , statements = S.fromList [tm01,tm02,tm03]         }  gm55 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 gm2,Formula b2 gm2f]-        , statements = [tm01,tm02,tm03,tm41,tm42,tm43]+        , formulae   = toFM [Formula b1 gm2,Formula b2 gm2f]+        , statements = S.fromList [tm01,tm02,tm03,tm41,tm42,tm43]         }  gm5s :: RDFGraph gm5s  = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 gm2]-        , statements = [tm01,tm02,tm03,+        , formulae   = toFM [Formula b1 gm2]+        , statements = S.fromList [tm01,tm02,tm03,                         arc s1 p1 o1, arc o1 p2 s3, arc s2 p3 o4]         }  gm6, gm66 :: RDFGraph gm6 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula ba1 gm2,Formula bn3 gm3]-        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14]+        , formulae   = toFM [Formula ba1 gm2,Formula bn3 gm3]+        , statements = S.fromList [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14]         }  gm66 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap+        , formulae   = toFM                        [Formula ba1 gm2,Formula bn3 gm3                        ,Formula ba3 gm2f,Formula bn5 gm3f                        ]-        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14+        , statements = S.fromList [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14                        ,tm67,tm68,tm69,tm70,tm71,tm72,tm73,tm74                        ]         }@@ -1444,9 +1452,9 @@ gm456 :: RDFGraph gm456 = NSGraph    { namespaces = nslist-  -- , formulae   = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]-  , formulae   = LookupMap []-  , statements = [tm01, tm04,+  -- , formulae   = toFM [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+  , formulae   = M.empty+  , statements = S.fromList [tm01, tm04,                   tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14                   , arc s1 p1 b4                   , arc b4 p1 o2@@ -1457,9 +1465,9 @@ gm564 :: RDFGraph gm564 = NSGraph    { namespaces = nslist-  -- , formulae   = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]-  , formulae   = LookupMap []-  , statements = [tm01, tm02, tm03+  -- , formulae   = toFM [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+  , formulae   = M.empty+  , statements = S.fromList [tm01, tm02, tm03                   , arc b5 p2 b6                   , tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14                   , arc s1 p1 b4@@ -1469,9 +1477,9 @@ gm645 :: RDFGraph gm645 = NSGraph    { namespaces = nslist-  -- , formulae   = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]-  , formulae   = LookupMap []-  , statements = [tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14+  -- , formulae   = toFM [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+  , formulae   = M.empty+  , statements = S.fromList [tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14                   , arc s1 p1 b4                   , arc b4 p1 o2                   , arc b4 p1 o3@@ -1502,21 +1510,21 @@ gm84, gm85, gm85a, gm86, gm86a :: RDFGraph gm84  = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 gm81,Formula v2 gm81]-        , statements = [tm81,tm82]+        , formulae   = toFM [Formula b1 gm81,Formula v2 gm81]+        , statements = S.fromList [tm81,tm82]         }  gm85 = NSGraph         { namespaces = nslist-        , formulae   = LookupMap [Formula b1 gm82,Formula v4 gm82]-        , statements = [tm811,tm821]+        , formulae   = toFM [Formula b1 gm82,Formula v4 gm82]+        , statements = S.fromList [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]+        , formulae   = toFM [Formula b1 gm82,Formula vb4 gm82]+        , statements = S.fromList [tm812,tm822]         } gm86a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm84 @@ -1544,7 +1552,7 @@               (mappend gm4 (mappend gm5 gm6))               (mappend (mappend gm4 gm5) gm6))   , testGraphEq "Remap07" True gm82 gm82a-  , testEquiv "testRemapList07" gm82b2 gm82b1+  , testEqv "testRemapList07" gm82b2 gm82b1   , testGraphEq "Remap08" True gm83 gm83a   , testGraphEq "Remap09" True gm85 gm85a   , testGraphEq "Remap10" True gm86 gm86a