diff --git a/Swish/RDF/ClassRestrictionRule.hs b/Swish/RDF/ClassRestrictionRule.hs --- a/Swish/RDF/ClassRestrictionRule.hs +++ b/Swish/RDF/ClassRestrictionRule.hs @@ -21,7 +21,7 @@ , makeDatatypeRestriction, makeDatatypeRestrictionFn , makeRDFClassRestrictionRules , makeRDFDatatypeRestrictionRules - , falseGraph, falseGraphStr + , falseGraph, falseGraphStr ) where diff --git a/Swish/RDF/Datatype.hs b/Swish/RDF/Datatype.hs --- a/Swish/RDF/Datatype.hs +++ b/Swish/RDF/Datatype.hs @@ -85,6 +85,11 @@ , deleteIndex ) +-- used to add Show instances for structures during debugging +-- but backed out again. +-- +-- import Swish.Utils.ShowM (ShowM(..)) + import Data.Maybe( isJust, catMaybes ) import Control.Monad( join, liftM ) @@ -121,15 +126,15 @@ typeMkModifiers :: Datatype ex lb vn -> [OpenVarBindingModify lb vn] typeMkModifiers (Datatype dtv) = tvalMkMods dtv --- |Get named axiom from Datatype value +-- |Get the named axiom from a Datatype value. getTypeAxiom :: ScopedName -> Datatype ex lb vn -> Maybe (Formula ex) getTypeAxiom nam dt = getRulesetAxiom nam (typeRules dt) --- |Get named rule from Datatype value +-- |Get the named rule from a Datatype value. getTypeRule :: ScopedName -> Datatype ex lb vn -> Maybe (Rule ex) -getTypeRule nam dt = getRulesetRule nam (typeRules dt) +getTypeRule nam dt = getRulesetRule nam (typeRules dt) --- |Get canonical form of datatype value +-- |Get the canonical form of a datatype value. typeMkCanonicalForm :: Datatype ex lb vn -> String -> Maybe String typeMkCanonicalForm (Datatype dtv) = tvalMkCanonicalForm dtv @@ -142,8 +147,8 @@ -- -- A datatype is specified with respect to (polymophic in) a given -- type of (syntactic) expression with which it may be used, and --- a value type (whos existence is hidden as an existential type --- within `DatatypeMap`. +-- a value type (whose existence is hidden as an existential type +-- within `DatatypeMap`). -- -- (I tried hiding the value type with an internal existential -- declaration, but that wouldn't wash. Hence this two-part @@ -241,6 +246,11 @@ -- value for @tvalRel@. } +{- +instance ShowM ex => Show (DatatypeVal ex vt lb vn) where + show dv = "DatatypeVal: " ++ show (tvalName dv) ++ "\n -> rules:\n" ++ show (tvalRules dv) +-} + -- Other accessor functions getDTRel :: @@ -253,7 +263,7 @@ getDTMod nam dtv = mapFindMaybe nam (LookupMap (tvalMod dtv)) --- |Get canonical form of datatype value, or @Nothing@. +-- |Get the canonical form of a datatype value, or @Nothing@. -- tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> String -> Maybe String tvalMkCanonicalForm dtv str = can @@ -269,8 +279,8 @@ -- data DatatypeMap vt = DatatypeMap { mapL2V :: String -> Maybe vt - -- ^ Function to map lexical string to - -- datatype value. This effectively + -- ^ Function to map a lexical string to + -- the datatype value. This effectively -- defines the lexical space of the -- datatype to be all strings for which -- yield a value other than @Nothing@. diff --git a/Swish/RDF/N3Parser.hs b/Swish/RDF/N3Parser.hs --- a/Swish/RDF/N3Parser.hs +++ b/Swish/RDF/N3Parser.hs @@ -80,17 +80,16 @@ , emptyRDFGraph ) -import Swish.RDF.GraphClass - ( arc ) +import Swish.RDF.GraphClass (arc) import Swish.Utils.LookupMap ( LookupMap(..) - , mapFind, mapFindMaybe, mapReplaceOrAdd ) + , LookupEntryClass(..) + , mapFind, mapFindMaybe, mapReplaceOrAdd, mapAdd, mapReplace ) import Swish.Utils.Namespace ( Namespace(..) , ScopedName(..) - , getScopePrefix , getScopedNameURI , makeScopedName, makeUriScopedName , makeQNameScopedName @@ -199,14 +198,6 @@ getPrefixNs :: N3State -> String -> Namespace getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre) --- Map ScopedName using prefix table --- (Ignore URI in supplied ScopedName) -getPrefixScopedName :: N3State -> ScopedName -> ScopedName -getPrefixScopedName st snam = ScopedName (getPrefixNs st pre) loc - where - pre = getScopePrefix snam - loc = snLocal snam - getKeywordsList :: N3State -> [String] getKeywordsList = keywordsList @@ -260,7 +251,7 @@ -> String -- ^ input to be parsed -> Either String a parseAnyfromString parser mbase input = - let pmap = LookupMap prefixTable + let pmap = LookupMap [] -- [Namespace "" "#"] -- [] -- emptyLookupMap -- LookupMap prefixTable muri = fmap makeQNameScopedName mbase smap = LookupMap $ specialTable muri pstate = N3State @@ -306,11 +297,24 @@ parseNameFromString = parseAnyfromString n3Name Nothing +{- +This has been made tricky by the attempt to remove the default list +of prefixes from the starting point of a N3 parse and the subsequent +attempt to add every new namespace we come across to the parser state. + +So we add in the original default namespaces for testing, since +this routine is really for testing. +-} + +addTestPrefixes :: N3Parser () +addTestPrefixes = updateState $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map + parsePrefixFromString :: String -> Either String Namespace parsePrefixFromString = parseAnyfromString p Nothing where p = do + addTestPrefixes pref <- n3Name st <- getState return (getPrefixNs st pref) -- map prefix to namespace @@ -325,8 +329,8 @@ parseAnyfromString lexUriRef Nothing parseURIref2FromString :: String -> Either String ScopedName -parseURIref2FromString = - parseAnyfromString n3symbol Nothing +parseURIref2FromString = + parseAnyfromString (addTestPrefixes >> n3symbol) Nothing -- parseAnyfromString uriRef2 Nothing ---------------------------------------------------------------------- @@ -382,14 +386,40 @@ getScopedNameURI' = showURI -- getScopedNameURI' = getScopedNameURI . makeUriScopedName . showURI -operatorLabel :: ScopedName -> N3Parser RDFLabel {- -operatorLabel snam = do - s <- getState - return $ Res $ getPrefixScopedName s snam --} -operatorLabel snam = (Res . flip getPrefixScopedName snam) <$> getState +Since operatorLabel can be used to add a label with an +unknown namespace, we need to ensure that the namespace +is added if not known. If the namespace prefix is already +in use then it is over-written (rather than add a new +prefix for the label). +TODO: + - 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 + mapReplaceOrAdd for the input namespace. + +-} +operatorLabel :: ScopedName -> N3Parser RDFLabel +operatorLabel snam@(ScopedName sns _) = do + st <- getState + let 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 + Just val | val == pval -> return rval + | otherwise -> do + setState $ st { prefixUris = mapReplace opmap sns } + return rval + + _ -> do + setState $ st { prefixUris = mapAdd opmap sns } + return rval + {- Add statement to graph in N3 parser state. @@ -1061,6 +1091,7 @@ | "@has" expression | "@is" expression "@of" | expression + -} verb :: N3Parser (RDFLabel -> RDFLabel -> AddStatement, RDFLabel) diff --git a/Swish/RDF/RDFDatatypeXsdInteger.hs b/Swish/RDF/RDFDatatypeXsdInteger.hs --- a/Swish/RDF/RDFDatatypeXsdInteger.hs +++ b/Swish/RDF/RDFDatatypeXsdInteger.hs @@ -133,10 +133,11 @@ -- Implmentation of RDFDatatypeVal for xsd:integer ------------------------------------------------------------ --- |Define Datatype value for xsd:integer +-- |Define Datatype value for @xsd:integer@. +-- -- Members of this datatype are positive or negative integer values. -- --- The lexical form consists of an option @+@ or @-@ +-- The lexical form consists of an optional @+@ or @-@ -- followed by a sequence of decimal digits. -- -- The canonical lexical form has leading zeros and @+@ sign removed. diff --git a/Swish/RDF/RDFProofContext.hs b/Swish/RDF/RDFProofContext.hs --- a/Swish/RDF/RDFProofContext.hs +++ b/Swish/RDF/RDFProofContext.hs @@ -73,9 +73,7 @@ ) import Swish.RDF.Vocabulary - ( namespaceRDF - , namespaceRDFS - , namespaceRDFD + ( namespaceRDFD , scopeRDF , scopeRDFS , scopeRDFD @@ -90,8 +88,7 @@ ------------------------------------------------------------ makeFormula :: Namespace -> String -> String -> RDFFormula -makeFormula scope local gr = - makeRDFFormula scope local (prefixRDF++gr) +makeFormula = makeRDFFormula requireAny :: [RDFVarBindingFilter] -> RDFVarBindingFilter requireAny = varFilterDisjunction @@ -219,13 +216,6 @@ ------------------------------------------------------------ -- Common definitions ------------------------------------------------------------ - -prefixRDF :: String -prefixRDF = - "@prefix rdf: <" ++ nsURI namespaceRDF ++ "> . \n" ++ - "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++ - "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++ - " \n" ------------------------------------------------------------ -- Define RDF axioms diff --git a/Swish/RDF/RDFRuleset.hs b/Swish/RDF/RDFRuleset.hs --- a/Swish/RDF/RDFRuleset.hs +++ b/Swish/RDF/RDFRuleset.hs @@ -13,6 +13,10 @@ -- This module defines some datatypes and functions that are -- used to define rules and rulesets over RDF graphs. -- +-- For the routines that accept a graph in N3 format, the following +-- namespaces are pre-defined for use by the graph: +-- @rdf:@ and @rdfs:@. +-- -------------------------------------------------------------------------------- module Swish.RDF.RDFRuleset @@ -75,8 +79,7 @@ ( Namespace(..) , ScopedName(..) ) -import Swish.RDF.Vocabulary - ( swishName ) +import Swish.RDF.Vocabulary (swishName, namespaceRDF, namespaceRDFS) {- import Swish.RDF.Proof @@ -237,10 +240,18 @@ -- Method for creating an RDF formula value from N3 text ------------------------------------------------------------ +prefixRDF :: String +prefixRDF = + "@prefix rdf: <" ++ nsURI namespaceRDF ++ "> . \n" ++ + "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++ + -- "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++ + " \n" + -- |Helper function to parse a string containing Notation3 -- and return the corresponding RDFGraph value. +-- makeRDFGraphFromN3String :: String -> RDFGraph -makeRDFGraphFromN3String str = case parseN3fromString str of +makeRDFGraphFromN3String str = case parseN3fromString (prefixRDF ++ str) of Left msg -> error msg Right gr -> gr diff --git a/Swish/RDF/Rule.hs b/Swish/RDF/Rule.hs --- a/Swish/RDF/Rule.hs +++ b/Swish/RDF/Rule.hs @@ -35,8 +35,7 @@ ( LookupEntryClass(..), LookupMap(..) ) -import Swish.Utils.ShowM - ( ShowM(..) ) +import Swish.Utils.ShowM (ShowM(..)) ------------------------------------------------------------ -- Expressions diff --git a/Swish/RDF/Ruleset.hs b/Swish/RDF/Ruleset.hs --- a/Swish/RDF/Ruleset.hs +++ b/Swish/RDF/Ruleset.hs @@ -34,17 +34,24 @@ , ScopedName(..) ) -import Swish.RDF.Rule - ( Formula(..), Rule(..) ) +import Swish.RDF.Rule (Formula(..), Rule(..)) import Swish.Utils.LookupMap ( LookupEntryClass(..), LookupMap(..) , mapFindMaybe ) -import Data.Maybe - ( fromMaybe, listToMaybe, mapMaybe ) +{- +Used for the Show instance of Ruleset, which was +used for debugging but has been removed as not +really needed by the general user. +import Swish.Utils.ShowM (ShowM(..)) +import Data.List (intercalate) +-} + +import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) + -- | Ruleset, having namespace, axioms and rules data Ruleset ex = Ruleset @@ -53,6 +60,19 @@ , rsRules :: [Rule ex] } +{- + +Used for debugging. + +instance (ShowM ex) => Show (Ruleset ex) where + show (Ruleset ns axs rls) = + intercalate "\n" + [ "Ruleset: " ++ show ns + , "Axioms:" ] + ++ (showsFormulae "\n" axs + (intercalate "\n" ("Rules:" : map show rls))) "" +-} + instance Eq (Ruleset ex) where r1 == r2 = rsNamespace r1 == rsNamespace r2 @@ -79,18 +99,19 @@ getRulesetRules :: Ruleset ex -> [Rule ex] getRulesetRules = rsRules --- | Find a named axiom or rule in a ruleset or proof context - +-- | 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 +-- | 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 +-- | Find a named axiom or rule in a proof context. getContextAxiom :: ScopedName -> Formula ex -> [Ruleset ex] -> Formula ex getContextAxiom nam def rsets = fromMaybe def (getMaybeContextAxiom nam rsets) {- diff --git a/Swish/Utils/LookupMap.hs b/Swish/Utils/LookupMap.hs --- a/Swish/Utils/LookupMap.hs +++ b/Swish/Utils/LookupMap.hs @@ -91,6 +91,19 @@ data LookupMap a = LookupMap [a] deriving (Functor, F.Foldable, T.Traversable) +{- +TODO: could add + +instance Monoid (LookupMap a) where + mempty = LookupMap [] + mappend = mapMerge + +but may need constraints on a, do not +want to add instances at this time, and is +it really useful? + +-} + gLM :: LookupMap a -> [a] gLM (LookupMap es) = es diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -1,5 +1,5 @@ Name: swish -Version: 0.3.1.2 +Version: 0.3.2.0 Stability: experimental License: LGPL License-file: LICENSE @@ -44,7 +44,11 @@ . * Complete, ready-to-run, command-line and script-driven programs. . - Major Changes: + Changes: + . + [Version 0.3.2.0] The N3 parser no longer assumes a set of pre-defined namespaces. + There is no API change worthy of a bump to the minor version number, but it + is a large-enough change in behaviour that I felt the need for the update. . [Version 0.3.1.2] 'Swish.RDF.RDFGraph.toRDFGraph' now sets up the namespace map of the graph based on the input labels (previously it diff --git a/tests/BuiltInMapTest.hs b/tests/BuiltInMapTest.hs --- a/tests/BuiltInMapTest.hs +++ b/tests/BuiltInMapTest.hs @@ -116,16 +116,15 @@ 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 lab a1 a2 = - TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) ) +testEqv = testMaker ListTest "Eqv" testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test -testEqvEqv lab a1 a2 = - TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 ) - where - ma1 = ListTest $ map ListTest a1 - ma2 = ListTest $ map ListTest a2 +testEqvEqv = testMaker (ListTest . map ListTest) "EqvEqv" testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test testHasEqv lab a1 a2 = @@ -135,11 +134,7 @@ ma2 = map ListTest a2 testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test -testMaybeEqv lab a1 a2 = - TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 ) - where - ma1 = (MaybeListTest a1) - ma2 = (MaybeListTest a2) +testMaybeEqv = testMaker MaybeListTest "MaybeEqv" ------------------------------------------------------------ -- Test finding built-in variable binding modifiers diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs --- a/tests/GraphTest.hs +++ b/tests/GraphTest.hs @@ -25,6 +25,7 @@ import Data.List (sort, elemIndex) import Data.Maybe (fromJust) +import Data.Ord (comparing) import Swish.Utils.ListHelpers import Swish.Utils.MiscHelpers @@ -93,7 +94,7 @@ tstLabelMap gen lvs = LabelMap gen (makeLookupMap $ makeEntries lvs) makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb] -makeEntries lvs = map newEntry lvs +makeEntries = map newEntry labelMapSortByVal :: (Label lb) => LabelMap lb -> LabelMap lb labelMapSortByVal (LabelMap gen lm) = LabelMap gen (mapSortByVal lm) @@ -104,7 +105,7 @@ -- select -testSelect :: String -> [Char] -> [Char] -> Test +testSelect :: String -> String -> String -> Test testSelect lab = testeq ("Select"++lab ) isOne :: Int -> Bool @@ -112,13 +113,11 @@ testSelect01, testSelect02, testSelect03, testSelect04 :: Test testSelect01 = testSelect "01" - (select isOne [0,1,2,0,1,2] ['a','b','c','a','b','c']) - ['b','b'] + (select isOne [0,1,2,0,1,2] "abcabc") "bb" testSelect02 = testSelect "02" - (select isOne [1,1,1,1,1,1] ['a','b','c','a','b','c']) - ['a','b','c','a','b','c'] + (select isOne [1,1,1,1,1,1] "abcabc") "abcabc" testSelect03 = testSelect "03" - (select isOne [0,0,0,0,0,0] ['a','b','c','a','b','c']) + (select isOne [0,0,0,0,0,0] "abcabc") [] testSelect04 = testSelect "04" (select isOne [] [] ) @@ -135,16 +134,16 @@ mf :: Int -> Char mf n = "_abcde" !! n -testMapset :: String -> [Int] -> [Char] -> Test +testMapset :: String -> [Int] -> String -> Test testMapset lab l1s l2s = testeq ("Mapset"++lab ) l2s (mapset mf l1s) testMapsetSuite :: Test testMapsetSuite = TestList - [ testMapset "01" [0,1,2,3,4,5] ['_','a','b','c','d','e'] - , testMapset "02" [1,1,3,3,5,5] ['a','c','e'] - , testMapset "03" [5,4,3,2,1,0] ['e','d','c','b','a','_'] + [ testMapset "01" [0,1,2,3,4,5] "_abcde" + , testMapset "02" [1,1,3,3,5,5] "ace" + , testMapset "03" [5,4,3,2,1,0] "edcba_" , testMapset "04" [] [] - , testMapset "05" [1,2,3,4,5,0] ['a','b','c','d','e','_'] + , testMapset "05" [1,2,3,4,5,0] "abcde_" ] -- subset @@ -170,7 +169,7 @@ testHash lab eq h1 h2 = testeq ("Hash"++lab ) eq (h1 == h2) testHashEq :: String -> Int -> Int -> Test -testHashEq lab h1 h2 = testeq ("Hash"++lab ) h1 h2 +testHashEq lab = testeq ("Hash"++lab ) testHashSuite :: Test testHashSuite = TestList @@ -455,8 +454,9 @@ testLab a b = a ++ "-" ++ b testOrd a b | testEq a b = EQ - | otherwise = compare (fromJust $ elemIndex a nodeorder) - (fromJust $ elemIndex b nodeorder) + | otherwise = comparing fromJust + (elemIndex a nodeorder) + (elemIndex b nodeorder) testEq a b = (a == b) || (a,b) `elem` nodeeqlist || (b,a) `elem` nodeeqlist @@ -1760,7 +1760,7 @@ , testGraphSuite , testLabelEqSuite , testLabelOrdSuite - , TestCase (assertBool "arc neq" ((Arc True True True) /= (Arc True True False))) -- silly test of Eq instance + , TestCase (assertBool "arc neq" (Arc True True True /= Arc True True False)) -- silly test of Eq instance , testStmtEqSuite , testLabelMapSuite , testGraphMatchSupportSuite diff --git a/tests/LookupMapTest.hs b/tests/LookupMapTest.hs --- a/tests/LookupMapTest.hs +++ b/tests/LookupMapTest.hs @@ -51,7 +51,7 @@ => LookupEntryClass (GenMapEntry a b) a b where keyVal (E k v) = (k,v) - newEntry (k,v) = (E k v) + newEntry (k,v) = E k v instance (Eq a, Show a, Eq b, Show b) => Show (GenMapEntry a b) where show = entryShow @@ -104,7 +104,7 @@ lm09 = mapDeleteAll lm08 2 la10 :: [String] -la10 = mapApplyToAll lm03 (flip replicate '*') +la10 = mapApplyToAll lm03 (`replicate` '*') lt11, lt12, lt13, lt14 :: String lt11 = mapTranslate lm03 la10 1 "****" @@ -376,10 +376,10 @@ -- Rather late in the day, generic versions of the testing functions used earlier type TestMapG a b = LookupMap (GenMapEntry a b) -newMapG :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> (TestMapG a b) +newMapG :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> TestMapG a b newMapG es = makeLookupMap (map newEntry es) -testLookupMapG :: (Eq a, Show a, Eq b, Show b) => String -> (TestMapG a b) -> [(a,b)] -> Test +testLookupMapG :: (Eq a, Show a, Eq b, Show b) => String -> TestMapG a b -> [(a,b)] -> Test testLookupMapG lab m1 m2 = testeq ("LookupMapG"++lab ) (newMapG m2) m1 testLookupMapM :: (Eq a, Show a, Eq b, Show b, Monad m, @@ -402,7 +402,7 @@ tf104 :: (LookupEntryClass a Int [b], LookupEntryClass c String Int) => a -> c -tf104 e = newEntry ( (flip replicate '#') k, 5-(length v) ) where (k,v) = keyVal e +tf104 e = newEntry (replicate k '#', 5 - length v) where (k,v) = keyVal e tm104 :: RevTestMap tm104 = mapTranslateEntries tf104 tm101 diff --git a/tests/N3FormatterTest.hs b/tests/N3FormatterTest.hs --- a/tests/N3FormatterTest.hs +++ b/tests/N3FormatterTest.hs @@ -24,8 +24,8 @@ import Swish.RDF.N3Parser (parseN3fromString) import Swish.RDF.RDFGraph - ( RDFGraph - , RDFLabel(..) + ( RDFGraph, RDFTriple + , RDFLabel(..), ToRDFLabel , NSGraph(..) , NamespaceMap , LookupFormula(..) @@ -637,7 +637,8 @@ graph_l1 = toGraph [arc s1 p1 lfr] graph_l2 = toGraph [arc s1 p1 lfoobar] graph_l3 = - let tf a = toRDFTriple s1 p1 a + let tf :: ToRDFLabel a => a -> RDFTriple + tf = toRDFTriple s1 p1 arcs = [ tf True , tf (12::Int) diff --git a/tests/N3ParserTest.hs b/tests/N3ParserTest.hs --- a/tests/N3ParserTest.hs +++ b/tests/N3ParserTest.hs @@ -65,7 +65,7 @@ -- Generic item parsing test wrapper ------------------------------------------------------------ -type ParseFromString a = String -> (Either String a) +type ParseFromString a = String -> Either String a parseItemTest :: (Eq a, Show a) => ParseFromString a -> a -> String -> String -> a -> String -> Test @@ -848,6 +848,9 @@ "@prefix base2 : <" ++ nsURI base2 ++ "> . \n" ++ "@prefix base3 : <" ++ nsURI base3 ++ "> . \n" +rdfPrefix :: String +rdfPrefix = "@prefix rdf: <" ++ nsURI namespaceRDF ++ ">.\n" + -- Single statement using form simpleN3Graph_g1_01 :: String simpleN3Graph_g1_01 = @@ -1088,7 +1091,7 @@ -- Literals with dataype and language simpleN3Graph_g17 :: String simpleN3Graph_g17 = - commonPrefixes ++ + commonPrefixes ++ rdfPrefix ++ " base1:s1 base1:p1 \"chat\"@fr . \n " ++ " base2:s2 base2:p2 \"
\"^^rdf:XMLLiteral . \n " ++ " base3:s3 base3:p3 \"chat\"^^rdf:XMLLiteral . \n " @@ -1369,7 +1372,7 @@ -- failTest :: String -> String -> String -> Test -failTest lbl gr pe = parseTest lbl gr emptyRDFGraph pe +failTest lbl gr = parseTest lbl gr emptyRDFGraph failN3Graph_g1 :: String failN3Graph_g1 = diff --git a/tests/QNameTest.hs b/tests/QNameTest.hs --- a/tests/QNameTest.hs +++ b/tests/QNameTest.hs @@ -182,7 +182,7 @@ -- Maybe Qname comparison ------------------------------------------------------------ -testMaybeQNameEq :: String -> Bool -> (Maybe QName) -> (Maybe QName) -> Test +testMaybeQNameEq :: String -> Bool -> Maybe QName -> Maybe QName -> Test testMaybeQNameEq lab eq n1 n2 = TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) ) diff --git a/tests/RDFDatatypeXsdIntegerTest.hs b/tests/RDFDatatypeXsdIntegerTest.hs --- a/tests/RDFDatatypeXsdIntegerTest.hs +++ b/tests/RDFDatatypeXsdIntegerTest.hs @@ -91,7 +91,7 @@ import Control.Monad (unless) -import Data.Maybe (isJust, fromMaybe) +import Data.Maybe (isJust, isNothing, fromMaybe) ------------------------------------------------------------ @@ -128,7 +128,7 @@ testNothing :: String -> Maybe a -> Test testNothing lab av = - TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) ) + TestCase ( assertBool ("testJust:"++lab) (isNothing av) ) -- Compare lists and lists of lists and Maybe lists for set equivalence: @@ -172,15 +172,15 @@ testMaybeEqv lab a1 a2 = TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 ) where - ma1 = (MaybeListTest a1) - ma2 = (MaybeListTest a2) + ma1 = MaybeListTest a1 + ma2 = MaybeListTest a2 ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ xsd_int_name :: String -> ScopedName -xsd_int_name nam = ScopedName namespaceXsdInteger nam +xsd_int_name = ScopedName namespaceXsdInteger axiomXsdIntegerDT :: ScopedName axiomXsdIntegerDT = xsd_int_name "dt" @@ -226,11 +226,11 @@ [ testEq "testDatatype01" typeNameXsdInteger $ typeName rdfDatatypeXsdInteger , testEq "testDatatype02" namespaceXsdInteger $ - rsNamespace (typeRules rdfDatatypeXsdInteger) + rsNamespace xsdIntRules , testEqv "testDatatype03" axiomsXsdInteger $ - rsAxioms (typeRules rdfDatatypeXsdInteger) + rsAxioms xsdIntRules , testEqv "testDatatype04" rulesXsdInteger $ - rsRules (typeRules rdfDatatypeXsdInteger) + rsRules xsdIntRules , testEq "testDatatype05" axiomXsdIntegerDT $ formName (getXsdIntegerAxiom axiomXsdIntegerDT) , testEq "testDatatype06" ruleXsdIntegerAbs $ @@ -308,9 +308,9 @@ String -> Maybe (RDFDatatypeMod Integer) -> [RDFVarBinding] -> [RDFVarBinding] -> Test -testVmod2 = testVmodN [(Var "a"),(Var "b")] -testVmod3 = testVmodN [(Var "a"),(Var "b"),(Var "c")] -testVmod4 = testVmodN [(Var "a"),(Var "b"),(Var "c"),(Var "d")] +testVmod2 = testVmodN [Var "a", Var "b"] +testVmod3 = testVmodN [Var "a", Var "b", Var "c"] +testVmod4 = testVmodN [Var "a", Var "b", Var "c", Var "d"] -- make various kinds of RDF variable bindings @@ -1548,7 +1548,7 @@ -- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr pvRules = typeMkRules rdfDatatypeXsdInteger gr where - gr = (mkGraph pvRulesStr) + gr = mkGraph pvRulesStr pvRulesStr :: String pvRulesStr = diff --git a/tests/RDFGraphTest.hs b/tests/RDFGraphTest.hs --- a/tests/RDFGraphTest.hs +++ b/tests/RDFGraphTest.hs @@ -63,6 +63,7 @@ import Data.Monoid (Monoid(..)) import Data.List (elemIndex, intercalate) import Data.Maybe (fromJust) +import Data.Ord (comparing) import System.Locale (defaultTimeLocale) import Data.Time (UTCTime(..), Day, fromGregorian, buildTime) @@ -650,7 +651,7 @@ (tnn06 : tnn07 : tnn08 : _ ) = newNodes s1 [b1,b3,v1,v2,tnns3] tnn09 :: RDFLabel -tnn09 = (newNodes l1 [b1,b3,v1,v2,tnns3])!!2 +tnn09 = newNodes l1 [b1,b3,v1,v2,tnns3] !! 2 tnns1, tnns2, tnns3, tnns4, tnnl1 :: RDFLabel tnns1 = Blank "Res_s1" @@ -679,7 +680,7 @@ testLabelOrd :: String -> Ordering -> RDFLabel -> RDFLabel -> Test testLabelOrd lab order n1 n2 = TestCase ( assertEqual - ("testLabelOrd:"++lab++"["++(show n1)++","++(show n2)++"]") + ("testLabelOrd:"++lab++"["++show n1++","++show n2++"]") order (compare n1 n2) ) nodeorder :: [String] @@ -713,8 +714,9 @@ tLab ll1 ll2 = ll1 ++ "-" ++ ll2 tOrd ll1 ll2 | tEq ll1 ll2 = EQ - | otherwise = compare (fromJust $ elemIndex ll1 nodeorder) - (fromJust $ elemIndex ll2 nodeorder) + | otherwise = comparing fromJust + (elemIndex ll1 nodeorder) + (elemIndex ll2 nodeorder) tEq ll1 ll2 = (ll1 == ll2) || (ll1,ll2) `elem` nodeeqlist || (ll2,ll1) `elem` nodeeqlist @@ -1306,11 +1308,11 @@ assertGrHelper :: String -> RDFGraph -> RDFGraph -> Bool -> Assertion assertGrHelper lbl gg1 gg2 = assertBool $ - lbl++"\nExpected: "++(show gg1)++"\nObtained: "++(show gg2) + lbl++"\nExpected: "++ show gg1 ++"\nObtained: "++ show gg2 assertGrEquiv :: String -> RDFGraph -> RDFGraph -> Assertion assertGrEquiv lbl gg1 gg2 = - assertGrHelper lbl gg1 gg2 $ (getArcs gg1) `equiv` (getArcs gg2) + assertGrHelper lbl gg1 gg2 $ getArcs gg1 `equiv` getArcs gg2 assertGrEq :: String -> RDFGraph -> RDFGraph -> Assertion assertGrEq lbl gg1 gg2 = diff --git a/tests/RDFProofContextTest.hs b/tests/RDFProofContextTest.hs --- a/tests/RDFProofContextTest.hs +++ b/tests/RDFProofContextTest.hs @@ -107,7 +107,7 @@ testProof :: String -> Bool -> RDFProof -> Test testProof lab valid proof = TestList [ TestCase $ assertEqual lab valid (checkProof proof) - , TestCase $ assertBool (lab++": "++ex) (valid == (isNothing $ expl)) + , TestCase $ assertBool (lab++": "++ex) (valid == isNothing expl) ] where expl = explainProof proof @@ -141,9 +141,9 @@ "rs_rdf" -> scopeRDF "rs_rdfs" -> scopeRDFS "rs_rdfd" -> scopeRDFD - "xsd_integer" -> (namespaceXsdType "integer") - "xsd_string" -> (namespaceXsdType "string") - _ -> error ("makeSName: Unrecognized prefix in rule name: "++nam) + "xsd_integer" -> namespaceXsdType "integer" + "xsd_string" -> namespaceXsdType "string" + _ -> error $ "makeSName: Unrecognized prefix in rule name: " ++ nam -- Common definitions @@ -189,7 +189,7 @@ rdfr1 = getRule "rs_rdf:r1" ant01, con01, bwd01 :: RDFGraph -ant01 = formExpr $ makeFormula scopeex "ant01" $ +ant01 = formExpr $ makeFormula scopeex "ant01" "ex:s ex:p1 ex:o1 ; ex:p2 ex:o2 ." con01 = formExpr $ makeFormula scopeex "con01" $ "ex:p1 rdf:type rdf:Property ." ++ @@ -207,9 +207,9 @@ rdfsr2 = getRule "rs_rdfs:r2" ant02, con02 :: RDFGraph -ant02 = formExpr $ makeFormula scopeex "ant02" $ +ant02 = formExpr $ makeFormula scopeex "ant02" "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ." -con02 = formExpr $ makeFormula scopeex "con02" $ +con02 = formExpr $ makeFormula scopeex "con02" "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ." -- Rule with literal test and "allocateTo": @@ -301,7 +301,7 @@ ant06 = formExpr $ makeFormula scopeex "ant06" $ "ex:s ex:p1 \"lit1\" . " ++ "ex:p1 rdfs:range ex:pr1 . " -con06 = formExpr $ makeFormula scopeex "con06" $ +con06 = formExpr $ makeFormula scopeex "con06" "_:o1 rdf:type ex:pr1 ." bwd06 = formExpr $ makeFormula scopeex "bwd06a" $ "_:s1 _:p1 _:o1 . " ++ @@ -371,12 +371,12 @@ [ rdfStep01a ] rdfBase02, rdfCon02a, rdfGoal02 :: RDFFormula -rdfBase02 = makeFormula scopeex "rdfBase02" $ +rdfBase02 = makeFormula scopeex "rdfBase02" "ex:s ex:p \"l1\"^^rdf:XMLLiteral ." rdfCon02a = makeFormula scopeex "rdfStep02a" $ "ex:s ex:p _:lll . " ++ "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . " -rdfGoal02 = makeFormula scopeex "rdfGoal02" $ +rdfGoal02 = makeFormula scopeex "rdfGoal02" "_:lll rdf:type rdf:XMLLiteral . " rdfStep02a, rdfStep02b :: RDFProofStep @@ -388,12 +388,12 @@ [ rdfStep02a, rdfStep02b ] rdfBase03, rdfCon03a, rdfGoal03 :: RDFFormula -rdfBase03 = makeFormula scopeex "rdfBase03" $ +rdfBase03 = makeFormula scopeex "rdfBase03" "ex:s ex:p ex:o ." rdfCon03a = makeFormula scopeex "rdfStep03a" $ "ex:s ex:p _:lll . " ++ "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . " -rdfGoal03 = makeFormula scopeex "rdfGoal03" $ +rdfGoal03 = makeFormula scopeex "rdfGoal03" "_:lll rdf:type rdf:XMLLiteral . " rdfStep03a, rdfStep03b :: RDFProofStep @@ -416,19 +416,20 @@ [ rdfStep04a ] rdfBase05 :: RDFFormula -rdfBase05 = makeFormula scopeex "rdfBase05" $ +rdfBase05 = makeFormula scopeex "rdfBase05" "ex:s ex:p rdf:nil ." rdfStep05a :: RDFProofStep rdfStep05a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase05] rdfCons05a rdfCons05a :: RDFFormula -rdfCons05a = makeFormula scopeex "rdfCons05a" $ +rdfCons05a = makeFormula scopeex "rdfCons05a" "ex:p rdf:type rdf:Property ." rdfStep05b :: RDFProofStep rdfStep05b = makeRDFProofStep (getRule "rs_rdf:se") - [rdfBase05,rdfCons05a,(getAxiom "rs_rdf:a8")] rdfGoal05 + [rdfBase05, rdfCons05a, getAxiom "rs_rdf:a8"] + rdfGoal05 rdfGoal05 :: RDFFormula rdfGoal05 = makeFormula scopeex "rdfGoal05" $ @@ -438,7 +439,7 @@ rdfProof05 :: RDFProof rdfProof05 = makeRDFProof rdfsContext rdfBase05 rdfGoal05 - [ rdfStep05a, rdfStep05b ] + [rdfStep05a, rdfStep05b] -- Swap rdfProof05 proof steps: @@ -498,21 +499,21 @@ -- rdf:_123 rdfs:supPropertyOf rdfs:member rdfBase08 :: RDFFormula -rdfBase08 = makeFormula scopeex "rdfBase08" $ +rdfBase08 = makeFormula scopeex "rdfBase08" "ex:s1 rdf:_123 ex:o ." rdfStep08a :: RDFProofStep rdfStep08a = makeRDFProofStep (getRule "rs_rdfs:cp1") [rdfBase08] rdfCons08a rdfCons08a :: RDFFormula -rdfCons08a = makeFormula scopeex "rdfCons08a" $ +rdfCons08a = makeFormula scopeex "rdfCons08a" "rdf:_123 rdf:type rdfs:ContainerMembershipProperty ." rdfStep08b :: RDFProofStep rdfStep08b = makeRDFProofStep (getRule "rs_rdfs:r12") [rdfCons08a] rdfGoal08 rdfGoal08 :: RDFFormula -rdfGoal08 = makeFormula scopeex "rdfCons08b" $ +rdfGoal08 = makeFormula scopeex "rdfCons08b" "rdf:_123 rdfs:subPropertyOf rdfs:member ." rdfProof08 :: RDFProof @@ -538,7 +539,7 @@ show (formName rdfAxiomIntDt) rdfBase09 :: RDFFormula -rdfBase09 = makeFormula scopeex "rdfBase09" $ +rdfBase09 = makeFormula scopeex "rdfBase09" "ex:s ex:p \"010\"^^xsd:integer ." rdfStep09a :: RDFProofStep @@ -546,7 +547,7 @@ [rdfAxiomIntDt,rdfBase09] rdfCons09a rdfCons09a :: RDFFormula -rdfCons09a = makeFormula scopeex "rdfCons09a" $ +rdfCons09a = makeFormula scopeex "rdfCons09a" "ex:s ex:p \"10\"^^xsd:integer ." rdfStep09b :: RDFProofStep @@ -563,7 +564,7 @@ [rdfAxiomIntDt,rdfCons09a,rdfCons09b] rdfCons09c rdfCons09c :: RDFFormula -rdfCons09c = makeFormula scopeex "rdfCons09c" $ +rdfCons09c = makeFormula scopeex "rdfCons09c" "_:l rdf:type xsd:integer ." rdfStep09d :: RDFProofStep @@ -619,7 +620,7 @@ [rdfBase10] rdfCons10a rdfCons10a :: RDFFormula -rdfCons10a = makeFormula scopeex "rdfCons10a" $ +rdfCons10a = makeFormula scopeex "rdfCons10a" "ex:s ex:p \"abc\"^^xsd:string . " rdfStep10b :: RDFProofStep @@ -627,7 +628,7 @@ [rdfBase10] rdfCons10b rdfCons10b :: RDFFormula -rdfCons10b = makeFormula scopeex "rdfCons10b" $ +rdfCons10b = makeFormula scopeex "rdfCons10b" "ex:s ex:p \"def\" . " rdfStep10c :: RDFProofStep @@ -646,7 +647,7 @@ testRdf :: Test testRdf = TestList - [ testProofStep "rdfStep01a" True [(getRule "rs_rdf:r1")] [formExpr rdfBase01] rdfStep01a + [ testProofStep "rdfStep01a" True [getRule "rs_rdf:r1"] [formExpr rdfBase01] rdfStep01a , testProof "rdfProof01" True rdfProof01 -- Really should have support for scoped bnodes , testProof "rdfProof02" True rdfProof02 diff --git a/tests/RDFProofTest.hs b/tests/RDFProofTest.hs --- a/tests/RDFProofTest.hs +++ b/tests/RDFProofTest.hs @@ -587,7 +587,7 @@ , testEq "testResult24" 1 (length fwd24) , testIn "testResult24a" result24a fwd24 , testEq "testBwd24" 4 (length bwd24) - , testIn "testBwd24a1" bwd24a1 (bwd24!!0) + , testIn "testBwd24a1" bwd24a1 (head bwd24) , testIn "testBwd24a2" bwd24a2 (bwd24!!1) , testIn "testBwd24a3" bwd24a3 (bwd24!!2) , testIn "testBwd24a4" bwd24a4 (bwd24!!3) diff --git a/tests/RDFRulesetTest.hs b/tests/RDFRulesetTest.hs --- a/tests/RDFRulesetTest.hs +++ b/tests/RDFRulesetTest.hs @@ -130,17 +130,16 @@ TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) ) -} +testSameAs :: (Ord a) => String -> String -> [a] -> [a] -> Test +testSameAs l1 l2 x y = + let z = sort x == sort y + in TestCase (assertBool ("testSameAs:" ++ l1 ++ ":" ++ l2) z) + testSameAxioms :: String -> [RDFFormula] -> [RDFFormula] -> Test -testSameAxioms lab as1 as2 = - TestCase ( assertBool ("testSameAxioms:"++lab) sameas ) - where - sameas = (sort as1) == (sort as2) +testSameAxioms = testSameAs "Axioms" testSameRules :: String -> [RDFRule] -> [RDFRule] -> Test -testSameRules lab rs1 rs2 = - TestCase ( assertBool ("testSameRules:"++lab) samers ) - where - samers = (sort rs1) == (sort rs2) +testSameRules = testSameAs "Rules" ------------------------------------------------------------ -- Common values diff --git a/tests/VarBindingTest.hs b/tests/VarBindingTest.hs --- a/tests/VarBindingTest.hs +++ b/tests/VarBindingTest.hs @@ -46,7 +46,7 @@ import Control.Monad (unless) import Data.List (union, intersect) -import Data.Maybe (isJust, fromJust) +import Data.Maybe (isJust, isNothing, fromJust) ------------------------------------------------------------ -- Test case helpers @@ -78,7 +78,7 @@ testNothing :: String -> Maybe a -> Test testNothing lab av = - TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) ) + TestCase ( assertBool ("testJust:"++lab) (isNothing av) ) -- Compare lists and lists of lists and Maybe lists for set equivalence: @@ -122,8 +122,8 @@ testMaybeEqv lab a1 a2 = TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 ) where - ma1 = (MaybeListTest a1) - ma2 = (MaybeListTest a2) + ma1 = MaybeListTest a1 + ma2 = MaybeListTest a2 ------------------------------------------------------------ -- Define and variable bindings @@ -175,45 +175,48 @@ vb21str = vb2str vb44str = vb4str +vbFull :: VarBinding a b -> Bool +vbFull = not . vbNull + testVarBindingSuite :: Test testVarBindingSuite = TestList - [ test "testVarBinding01" $ (vb1==vb2) - , test "testVarBinding02" $ (vb1/=vb3) - , test "testVarBinding03" $ (vb1/=vb4) + [ test "testVarBinding01" (vb1==vb2) + , test "testVarBinding02" (vb1/=vb3) + , test "testVarBinding03" (vb1/=vb4) , testEq "testVarBinding04" vb1str $ show vb1 , testEq "testVarBinding05" vb2str $ show vb2 , testEq "testVarBinding06" vb4str $ show vb4 , testEq "testVarBinding10" [1,2,3] $ boundVars vb1 , testEq "testVarBinding11" [3,2,1] $ boundVars vb2 , testEq "testVarBinding12" [] $ boundVars vb4 - , test "testVarBinding20" $ (subBinding vb1 vb2) - , test "testVarBinding21" $ (subBinding vb1 vb3) + , test "testVarBinding20" (subBinding vb1 vb2) + , test "testVarBinding21" (subBinding vb1 vb3) , test "testVarBinding22" $ not (subBinding vb1 vb4) - , test "testVarBinding23" $ (subBinding vb2 vb1) + , test "testVarBinding23" (subBinding vb2 vb1) , test "testVarBinding24" $ not (subBinding vb3 vb1) - , test "testVarBinding25" $ (subBinding vb4 vb1) - , test "testVarBinding26" $ (subBinding vb4 vb4) + , test "testVarBinding25" (subBinding vb4 vb1) + , test "testVarBinding26" (subBinding vb4 vb4) , testEq "testVarBinding30" 0 $ applyVarBinding vb5 0 , testEq "testVarBinding31" 11 $ applyVarBinding vb5 1 , testEq "testVarBinding32" 22 $ applyVarBinding vb5 2 , testEq "testVarBinding33" 33 $ applyVarBinding vb5 3 , testEq "testVarBinding34" 4 $ applyVarBinding vb5 4 , testEq "testVarBinding35" 11 $ applyVarBinding vb5 11 - , test "testVarBinding40" $ not (vbNull vb12) - , test "testVarBinding41" $ not (vbNull vb13) - , test "testVarBinding42" $ not (vbNull vb14) - , test "testVarBinding43" $ not (vbNull vb16) - , test "testVarBinding44" $ not (vbNull vb21) - , test "testVarBinding45" $ (vbNull vb44) - , test "testVarBinding50" $ (subBinding vb12 vb13) - , test "testVarBinding51" $ (subBinding vb12 vb14) - , test "testVarBinding52" $ (subBinding vb12 vb16) - , test "testVarBinding53" $ (subBinding vb12 vb21) + , test "testVarBinding40" (vbFull vb12) + , test "testVarBinding41" (vbFull vb13) + , test "testVarBinding42" (vbFull vb14) + , test "testVarBinding43" (vbFull vb16) + , test "testVarBinding44" (vbFull vb21) + , test "testVarBinding45" (vbNull vb44) + , test "testVarBinding50" (subBinding vb12 vb13) + , test "testVarBinding51" (subBinding vb12 vb14) + , test "testVarBinding52" (subBinding vb12 vb16) + , test "testVarBinding53" (subBinding vb12 vb21) , test "testVarBinding54" $ not (subBinding vb12 vb44) , test "testVarBinding55" $ not (subBinding vb13 vb12) - , test "testVarBinding56" $ (subBinding vb14 vb12) - , test "testVarBinding57" $ (subBinding vb44 vb12) + , test "testVarBinding56" (subBinding vb14 vb12) + , test "testVarBinding57" (subBinding vb44 vb12) , test "testVarBinding58" $ not (subBinding vb16 vb12) , testEq "testVarBinding60" vb12str $ show vb12 , testEq "testVarBinding61" vb13str $ show vb13 @@ -256,7 +259,7 @@ vbm1 :: VarBindingModify String Int vbm1 = VarBindingModify { vbmName = swishName "vbm1" - , vbmApply = map (\vb -> joinVarBindings vb vb9m) + , vbmApply = map (`joinVarBindings` vb9m) , vbmVocab = boundVars vb9m , vbmUsage = [boundVars vb9m] } @@ -327,7 +330,7 @@ , testEq "testVarModifyName02" (swishName "vbm2") $ vbmName vbm2 , testEq "testVarModify20" 2 $ length vb12m2 - , testEq "testVarModify21" vb1m $ vb12m2!!0 + , testEq "testVarModify21" vb1m $ head vb12m2 , testEq "testVarModify22" vb2m $ vb12m2!!1 , testEq "testVarModify23" (Just []) $ vbmCompatibility vbm2 ["a","b"] @@ -340,10 +343,10 @@ , testEq "testVarModifyName03" (swishName "vbm3") $ vbmName vbm3 , testEq "testVarModify30" 4 $ length vb16m3 - , testEq "testVarModify31" vb5m $ (vb16m3!!0) - , testEq "testVarModify32" vb5m $ (vb16m3!!1) - , testEq "testVarModify33" vb5m $ (vb16m3!!2) - , testEq "testVarModify34" vb5m $ (vb16m3!!3) + , testEq "testVarModify31" vb5m (head vb16m3) + , testEq "testVarModify32" vb5m (vb16m3!!1) + , testEq "testVarModify33" vb5m (vb16m3!!2) + , testEq "testVarModify34" vb5m (vb16m3!!3) , testEq "testVarModify35" (Just ["c"]) $ vbmCompatibility vbm3 ["a","b"] , testEq "testVarModify36" (Just ["b"]) $ @@ -549,10 +552,10 @@ , testEqv "testVarCompose35" [vbabcd,vbabcd,vbabcd] $ vbmApply vbm43 [vbac,vbad,vbcd] - , test "testVarCompose41" $ not (isJust vbm56) - , test "testVarCompose42" $ not (isJust vbm65) - , test "testVarCompose43" $ not (isJust vbm78) - , test "testVarCompose44" $ (isJust vbm87) + , test "testVarCompose41" (isNothing vbm56) + , test "testVarCompose42" (isNothing vbm65) + , test "testVarCompose43" (isNothing vbm78) + , test "testVarCompose44" (isJust vbm87) , testEqvEqv "testVarCompose45" vbm87usage $ vbmUsage (fromJust vbm87) @@ -650,7 +653,7 @@ [ [ ("a",1), ("b",2), ("c",3), ("d",4), ("e",7) ] ] compApply :: [VarBindingModify String Int] -> [VarBinding String Int] -compApply vbms = (vbmApply (head vbms)) compBindings +compApply vbms = vbmApply (head vbms) compBindings jcompab, jcompac, jcompad, jcompae, jcompba, jcompbc, jcompbd, jcompbe, @@ -673,22 +676,22 @@ testFindCompSuite = TestList [ testEq "testVarModifyName08" (swishName "__vbm4_vbm3__vbm9_") $ - vbmName (compad!!0) + vbmName (head compad) , testEq "testVarModifyName08" (swishName "__vbm4_vbm9__vbm3_") $ vbmName (compad!!1) - , testEq "testFindComp01" 1 $ (length compab) - , testEq "testFindComp02" 3 $ (length compac) - , testEq "testFindComp03" 2 $ (length compad) - , testEq "testFindComp04" 0 $ (length compae) - , testEq "testFindComp05" 1 $ (length compba) - , testEq "testFindComp06" 1 $ (length compbc) - , testEq "testFindComp07" 0 $ (length compbd) - , testEq "testFindComp08" 0 $ (length compbe) - , testEq "testFindComp09" 3 $ (length compca) - , testEq "testFindComp10" 3 $ (length compcd) - , testEq "testFindComp11" 1 $ (length compce) - , testEq "testFindComp12" 1 $ (length compde) + , testEq "testFindComp01" 1 (length compab) + , testEq "testFindComp02" 3 (length compac) + , testEq "testFindComp03" 2 (length compad) + , testEq "testFindComp04" 0 (length compae) + , testEq "testFindComp05" 1 (length compba) + , testEq "testFindComp06" 1 (length compbc) + , testEq "testFindComp07" 0 (length compbd) + , testEq "testFindComp08" 0 (length compbe) + , testEq "testFindComp09" 3 (length compca) + , testEq "testFindComp10" 3 (length compcd) + , testEq "testFindComp11" 1 (length compce) + , testEq "testFindComp12" 1 (length compde) , testEqv "testFindComp21" compvocab $ vbmVocab (head compab) , testEqv "testFindComp22" compvocab $ vbmVocab (head compac) @@ -710,15 +713,15 @@ , testHasEqv "testFindComp38" ["a","b","d"] $ vbmUsage (head compce) , testHasEqv "testFindComp39" ["a","b","c"] $ vbmUsage (head compde) - , testEqv "testFindComp41" compResult $ (compApply compab) - , testEqv "testFindComp42" compResult $ (compApply compac) - , testEqv "testFindComp43" compResult $ (compApply compad) - , testEqv "testFindComp44" compResult $ (compApply compba) - , testEqv "testFindComp45" compResult $ (compApply compbc) - , testEqv "testFindComp46" compResult $ (compApply compca) - , testEqv "testFindComp47" compResult $ (compApply compcd) - , testEqv "testFindComp48" compResult $ (compApply compce) - , testEqv "testFindComp49" compResult $ (compApply compde) + , testEqv "testFindComp41" compResult (compApply compab) + , testEqv "testFindComp42" compResult (compApply compac) + , testEqv "testFindComp43" compResult (compApply compad) + , testEqv "testFindComp44" compResult (compApply compba) + , testEqv "testFindComp45" compResult (compApply compbc) + , testEqv "testFindComp46" compResult (compApply compca) + , testEqv "testFindComp47" compResult (compApply compcd) + , testEqv "testFindComp48" compResult (compApply compce) + , testEqv "testFindComp49" compResult (compApply compde) , testJust "testFindComp51" jcompab , testJust "testFindComp52" jcompac