diff --git a/src/Data/Interned/URI.hs b/src/Data/Interned/URI.hs --- a/src/Data/Interned/URI.hs +++ b/src/Data/Interned/URI.hs @@ -67,7 +67,10 @@ -- Rather than access the URI components, just use the reverse of the -- string representation of the URI. instance Hashable (Description InternedURI) where +#if MIN_VERSION_hashable(1,2,0) +#else hash = hashWithSalt 5381 -- use the stringSalt value from Data.Hashable +#endif hashWithSalt salt (DU u) = hashWithSalt salt ((reverse . show) u) iuCache :: Cache InternedURI diff --git a/src/Swish/GraphClass.hs b/src/Swish/GraphClass.hs --- a/src/Swish/GraphClass.hs +++ b/src/Swish/GraphClass.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} @@ -14,7 +15,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental --- Portability : DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiParamTypeClasses +-- Portability : CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiParamTypeClasses -- -- This module defines a Labelled Directed Graph and Label classes, -- and the Arc datatype. @@ -159,7 +160,10 @@ type ArcSet lb = S.Set (Arc lb) instance (Hashable lb) => Hashable (Arc lb) where +#if MIN_VERSION_hashable(1,2,0) +#else hash (Arc s p o) = hash s `hashWithSalt` p `hashWithSalt` o +#endif hashWithSalt salt (Arc s p o) = salt `hashWithSalt` s `hashWithSalt` p `hashWithSalt` o -- | Create an arc. diff --git a/src/Swish/GraphMatch.hs b/src/Swish/GraphMatch.hs --- a/src/Swish/GraphMatch.hs +++ b/src/Swish/GraphMatch.hs @@ -40,7 +40,7 @@ import Control.Arrow (second) import Data.Function (on) -import Data.Hashable (combine) +import Data.Hashable (hashWithSalt) import Data.List (foldl', sortBy, groupBy, partition) import Data.Ord (comparing) import Data.Word @@ -192,7 +192,7 @@ makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam labelIsVar (ScopedLabel _ lab) = labelIsVar lab labelHash seed (ScopedLabel scope lab) - | labelIsVar lab = seed `combine` scope -- MH.hash seed $ show scope ++ "???" + | labelIsVar lab = seed `hashWithSalt` scope | otherwise = labelHash seed lab instance (Label lb) => Eq (ScopedLabel lb) where @@ -478,10 +478,9 @@ initVal :: (Label lb) => lb -> Word32 initVal = fromIntegral . hashVal 0 -hashVal :: (Label lb) => Int -> lb -> Int +hashVal :: (Label lb) => Word32 -> lb -> Int hashVal seed lab = - if labelIsVar lab then seed `combine` 23 else labelHash seed lab - -- if labelIsVar lab then hash seed "???" else labelHash seed lab + if labelIsVar lab then 23 `hashWithSalt` seed else labelHash (fromIntegral seed) lab -- | Return the equivalence classes of the supplied nodes -- using the label map. @@ -588,12 +587,15 @@ where gen' = gen+1 newEntries = [ (l, (gen', fromIntegral (newIndex l))) | l <- ls ] + -- TODO: should review this given the changes to the hash code + -- since it was re-written 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 + | otherwise = fromIntegral $ hashVal gen l -- otherwise rehash (to disentangle collisions) + -- mapAdjacent used to use `rem` hashModulus + mapAdjacent l = hashModulus `hashWithSalt` sum (sigsOver l) + gls = S.toList gs sigsOver l = select (hasLabel l) gls (arcSignatures lmap gls) @@ -631,11 +633,10 @@ map (sigCalc . arcToTriple) where sigCalc (s,p,o) = - fromIntegral ( labelVal2 s + - labelVal2 p * 3 + - labelVal2 o * 5 ) - `combine` hashModulus - -- `rem` hashModulus + hashModulus `hashWithSalt` + ( labelVal2 s + + labelVal2 p * 3 + + labelVal2 o * 5 ) labelVal = mapLabelIndex lmap labelVal2 = uncurry (*) . labelVal @@ -670,7 +671,7 @@ -> ArcSet lb -> ArcSet lb -> Bool -graphMapEq lmap = (==) `on` (graphMap lmap) +graphMapEq lmap = (==) `on` graphMap lmap -------------------------------------------------------------------------------- -- diff --git a/src/Swish/GraphMem.hs b/src/Swish/GraphMem.hs --- a/src/Swish/GraphMem.hs +++ b/src/Swish/GraphMem.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -12,7 +13,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental --- Portability : FlexibleInstances, MultiParamTypeClasses +-- Portability : CPP, FlexibleInstances, MultiParamTypeClasses -- -- This module defines a simple memory-based graph instance. -- @@ -34,7 +35,7 @@ import Swish.GraphClass import Swish.GraphMatch -import Data.Hashable (Hashable(..), combine) +import Data.Hashable (Hashable(..)) import Data.Monoid (Monoid(..)) import Data.Ord (comparing) @@ -115,10 +116,12 @@ | LV String instance Hashable LabelMem where + hashWithSalt salt (LF l) = salt `hashWithSalt` (1::Int) `hashWithSalt` l + hashWithSalt salt (LV l) = salt `hashWithSalt` (2::Int) `hashWithSalt` l +#if !MIN_VERSION_hashable(1,2,0) hash (LF l) = 1 `hashWithSalt` l hash (LV l) = 2 `hashWithSalt` l - hashWithSalt salt (LF l) = salt `combine` 1 `hashWithSalt` l - hashWithSalt salt (LV l) = salt `combine` 2 `hashWithSalt` l +#endif instance Label LabelMem where labelIsVar (LV _) = True diff --git a/src/Swish/RDF/Datatype/XSD/Integer.hs b/src/Swish/RDF/Datatype/XSD/Integer.hs --- a/src/Swish/RDF/Datatype/XSD/Integer.hs +++ b/src/Swish/RDF/Datatype/XSD/Integer.hs @@ -355,7 +355,7 @@ f0 _ = [] f1 [v2,v3] = [v2*v3] f1 _ = [] - f2 [v1,vi] = if r == 0 then [q] else [] + f2 [v1,vi] = [q | r == 0] where (q,r) = quotRem v1 vi f2 _ = [] diff --git a/src/Swish/RDF/Graph.hs b/src/Swish/RDF/Graph.hs --- a/src/Swish/RDF/Graph.hs +++ b/src/Swish/RDF/Graph.hs @@ -186,6 +186,7 @@ import Swish.QName (QName, getLName) import Control.Applicative (Applicative(pure), (<$>), (<*>)) +import Control.Arrow ((***)) import Network.URI (URI) @@ -1068,7 +1069,7 @@ -- 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 +fmapFormulaMap f m = M.fromList $ map (f *** fmapNSGraph f) $ M.assocs m -- TODO: how to traverse formulamaps now? diff --git a/src/Swish/Rule.hs b/src/Swish/Rule.hs --- a/src/Swish/Rule.hs +++ b/src/Swish/Rule.hs @@ -200,8 +200,8 @@ nullRule :: Rule ex nullRule = Rule { ruleName = makeNSScopedName nullScope "nullRule" - , fwdApply = \ _ -> [] - , bwdApply = \ _ -> [] + , fwdApply = const [] + , bwdApply = const [] , checkInference = \ _ _ -> False } diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -1,5 +1,5 @@ Name: swish -Version: 0.8.0.3 +Version: 0.9.0.0 Stability: experimental License: LGPL License-file: LICENSE @@ -44,51 +44,13 @@ . * Complete, ready-to-run, command-line and script-driven programs. . - Changes in version @0.8.0.3@: - . - * Fix up the tests so that they pass with @hashable-1.1.2.5@. - . - * Update to support @network-2.4.0.0@: @Network.URI.Ord@ is now a no-op - since the network package provides the instance; fix to change in API - of @relativeTo@. - . - * Removed binary constraint as unused. - . - Changes in version @0.8.0.2@: - . - * Restrict @hashable@ since tests fail with @1.1.2.5@ - (this is a hack). - . - * Updated @directory@ constraint to include @1.2@ on ghc 7.6. - . - Changes in version @0.8.0.1@ (unreleased): - . - * Internal changes to Turtle/N3 formatting. No user-visible changes. - . - Changes in version @0.8.0.0@: - . - * 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. - . - * Replaced used of @Data.LookupMap@ with @Data.Map.Map@. This has led to the - removal of a number of language extensions from some modules. - . - * Added @Network.URI.Ord@ to provide an ordering for URIs. + Changes in version @0.9.0.0@: . - * 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@. + * Updated to support @hashable-1.2@ series; although this should *not* + change the API from the @0.8@ series, I have decided to bump up the version to + @0.9@ just in case. . - * The containers upper limit has been increased to support version 0.5. + * Fix failing test on 64-bit GHC (no change to the library). . Changes in previous versions can be found at . . @@ -122,7 +84,7 @@ base >=3 && < 5, containers >= 0.4 && < 0.6, filepath >= 1.1 && < 1.4, - hashable == 1.1.*, + hashable >= 1.1 && < 1.3, mtl >= 2 && < 3, network >= 2.2 && < 2.5, old-locale == 1.0.*, diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs --- a/tests/GraphTest.hs +++ b/tests/GraphTest.hs @@ -41,7 +41,7 @@ import TestHelpers (runTestSuite, testEq, testNe) import Data.Function (on) -import Data.Hashable (combine) +import Data.Hashable (hashWithSalt) import Data.List (sort, sortBy, elemIndex) import Data.Maybe (fromJust) import Data.Ord (comparing) @@ -654,18 +654,20 @@ -- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb bhash :: Word32 -bhash = 23 +-- bhash = 23 -- before trying to support Hashable 1.2.0 +bhash = fromIntegral (23 `hashWithSalt` (0::Word32)) -- since the hashing is now done by hashable, is it worth checking --- the hash values directly? +-- the hash values directly? It would perhaps be better to just +-- quickcheck that values get sorted. -- copy of internal code in GraphMatch -toHash :: (Label lb) => Int -> lb -> Word32 +toHash :: (Label lb) => Word32 -> lb -> Word32 toHash s lbl = fromIntegral $ if labelIsVar lbl - then s `combine` 23 - else labelHash s lbl + then 23 `hashWithSalt` s + else labelHash (fromIntegral s) lbl l1hash, l4hash, l10hash :: Word32 l1hash = toHash 0 l1 diff --git a/tests/RDFGraphTest.hs b/tests/RDFGraphTest.hs --- a/tests/RDFGraphTest.hs +++ b/tests/RDFGraphTest.hs @@ -52,7 +52,7 @@ , xsdDate ) -import Control.Arrow (first) +import Control.Arrow ((&&&), first) import Data.List (elemIndex, intercalate) import Data.Maybe (fromJust, fromMaybe) @@ -364,6 +364,15 @@ testFrConv lbl sVal dtype hVal ] +-- get an integer that is larger than can be stored in an Int +-- (could just pick a value bigger than maxBound seen on a 64-bit build +-- but try to be fancy) +-- +bigInt :: T.Text +bigInt = let bi :: Integer + bi = fromIntegral (maxBound :: Int) + 11 + in T.pack $ show bi + -- some conversions (e.g. toRDFTriple) are covered by -- other tests -- @@ -379,7 +388,7 @@ , testEq "fconv:fail bool2" (Nothing :: Maybe Bool) (fromRDFLabel (TypedLit "True" xsdBoolean)) -- should we just let this be valid? , testEq "fconv:fail bool3" (Nothing :: Maybe Bool) (fromRDFLabel (TypedLit "true" xsdFloat)) , testEq "fconv:fail int1" (Nothing :: Maybe Int) (fromRDFLabel l1) - , testEq "fconv:fail int2" (Nothing :: Maybe Int) (fromRDFLabel (TypedLit "123456789012345" xsdInteger)) + , testEq "fconv:fail int2" (Nothing :: Maybe Int) (fromRDFLabel (TypedLit bigInt xsdInteger)) , testEq "fconv:fail float1" (Nothing :: Maybe Float) (fromRDFLabel l1) , testEq "fconv:fail float2" (Nothing :: Maybe Float) (fromRDFLabel (TypedLit "1.234e101" xsdFloat)) -- invalid input , testEq "fconv:fail float3" (Nothing :: Maybe Float) (fromRDFLabel (TypedLit "-1.234e101" xsdFloat)) -- invalid input @@ -1069,8 +1078,7 @@ " (base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral) }" toFM :: [Formula RDFLabel] -> FormulaMap RDFLabel -toFM = M.fromList . map (\fm -> (formLabel fm, formGraph fm)) --- toFM = M.fromList . map (\fm -> (formLabel fm, fm)) +toFM = M.fromList . map (formLabel &&& formGraph) fm2, fm3, fm4, fm5, fm6, fm7 :: FormulaMap RDFLabel fm2 = toFM [lf22] diff --git a/tests/RDFRulesetTest.hs b/tests/RDFRulesetTest.hs --- a/tests/RDFRulesetTest.hs +++ b/tests/RDFRulesetTest.hs @@ -341,8 +341,8 @@ TestList [ test "testRDF01" (isJust rdfr2modc) , testVal "testRDF02" rdfr2b1 rdfr2v1 - , test "testRDF03" $ rdfr2v2 == [] - -- , test "testRDF04" $ rdfr2v3 == [] + , test "testRDF03" $ null rdfr2v2 + -- , test "testRDF04" $ null rdfr2v3 , testEq "testRDF09" True [] $ bwdApply rdfr2rul con03 ]