diff --git a/src/Network/URI/Ord.hs b/src/Network/URI/Ord.hs --- a/src/Network/URI/Ord.hs +++ b/src/Network/URI/Ord.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- @@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental --- Portability : H98 +-- Portability : CPP -- -- Provide an ordering for URIs (that is, an 'Ord' instance for -- 'URI'). @@ -18,10 +20,17 @@ -- and no attempt is made to decode percent-encoded values (i.e. -- the comparison does /not/ use a canonical or normalized form). -- +-- For @network@ version @2.4.0.0@ and higher, this module is a no-op, +-- since 'Network.URI' now defines these instances. +-- -------------------------------------------------------------------------------- module Network.URI.Ord () where +#if MIN_VERSION_network(2,4,0) + +#else + import Network.URI (URI(..), URIAuth(..)) -- NOTE: we do not say compare = comparing show for the URI @@ -35,6 +44,8 @@ instance Ord URIAuth where URIAuth ui1 rn1 p1 `compare` URIAuth ui2 rn2 p2 = (ui1,rn1,p1) `compare` (ui2,rn2,p2) + +#endif -------------------------------------------------------------------------------- -- diff --git a/src/Swish/RDF/Parser/Utils.hs b/src/Swish/RDF/Parser/Utils.hs --- a/src/Swish/RDF/Parser/Utils.hs +++ b/src/Swish/RDF/Parser/Utils.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} + -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- @@ -9,7 +11,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental --- Portability : OverloadedStrings +-- Portability : CPP, OverloadedStrings -- -- Support for the RDF Parsing modules. -- @@ -82,16 +84,30 @@ -- | Append the two URIs. Should probably be moved -- out of RDFParser. It is also just a thin wrapper around -- `Network.URI.relativeTo`. +-- +-- Apparently, @relativeTo@ always returns @Just@ (at least +-- prior to version @2.4.0.0@ of @network), so we do not +-- expect this to ever fail (return `Left`). +-- appendURIs :: URI -- ^ The base URI -> URI -- ^ The URI to append (it can be an absolute URI). -> Either String URI +#if MIN_VERSION_network(2,4,0) appendURIs base uri = case uriScheme uri of + "" -> Right $ uri `relativeTo` base + _ -> Right uri + +#else +appendURIs base uri = + case uriScheme uri of "" -> case uri `relativeTo` base of Just out -> Right out _ -> Left $ "Unable to append <" ++ show uri ++ "> to base=<" ++ show base ++ ">" _ -> Right uri + +#endif -- | Type for special name lookup table type SpecialMap = M.Map String ScopedName diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -1,5 +1,5 @@ Name: swish -Version: 0.8.0.2 +Version: 0.8.0.3 Stability: experimental License: LGPL License-file: LICENSE @@ -44,6 +44,16 @@ . * 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@ @@ -51,7 +61,7 @@ . * Updated @directory@ constraint to include @1.2@ on ghc 7.6. . - Changes in version @0.8.0.1@: + Changes in version @0.8.0.1@ (unreleased): . * Internal changes to Turtle/N3 formatting. No user-visible changes. . @@ -110,13 +120,11 @@ Library Build-Depends: base >=3 && < 5, - binary == 0.5.*, containers >= 0.4 && < 0.6, filepath >= 1.1 && < 1.4, - -- hashable == 1.1.*, - hashable >= 1.1 && < 1.1.2.4, + hashable == 1.1.*, mtl >= 2 && < 3, - network >= 2.2 && < 2.4, + network >= 2.2 && < 2.5, old-locale == 1.0.*, polyparse >= 1.6 && < 1.9, semigroups >= 0.5 && < 0.9, @@ -241,7 +249,8 @@ Build-Depends: base, - containers, + containers, + hashable, HUnit, swish diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs --- a/tests/GraphTest.hs +++ b/tests/GraphTest.hs @@ -38,9 +38,11 @@ -- import Swish.Utils.ListHelpers (subset) -import TestHelpers (runTestSuite, testEq) +import TestHelpers (runTestSuite, testEq, testNe) -import Data.List (sort, elemIndex) +import Data.Function (on) +import Data.Hashable (combine) +import Data.List (sort, sortBy, elemIndex) import Data.Maybe (fromJust) import Data.Ord (comparing) import Data.Word (Word32) @@ -149,12 +151,22 @@ , testEq "Lab03" False (labelIsVar lab2f) , testEq "Lab04" True (labelIsVar lab2v) + {- This just tests the hash routine, which doesn't + really tell us that much, so replace by checks that the + hashes aren't the same , testEq "Lab05" 39495998 (labelHash 1 lab1f) , testEq "Lab06" 45349309 (labelHash 1 lab1v) , testEq "Lab07" 39495997 (labelHash 1 lab2f) , testEq "Lab08" 45349310 (labelHash 1 lab2v) - + -} + , testNe "Hash Lab05/6" (labelHash 1 lab1f) (labelHash 1 lab1v) + , testNe "Hash Lab05/7" (labelHash 1 lab1f) (labelHash 1 lab2f) + , testNe "Hash Lab06/8" (labelHash 1 lab1v) (labelHash 1 lab2v) + , testNe "Hash Lab07/8" (labelHash 1 lab2f) (labelHash 1 lab2v) + , testNe "Hash Lab05/8" (labelHash 1 lab1f) (labelHash 1 lab2v) + , testNe "Hash Lab06/7" (labelHash 1 lab1v) (labelHash 1 lab2f) + , testEq "Lab09" "!lab1" (show lab1f) , testEq "Lab10" "?lab1" (show lab1v) , testEq "Lab11" "!lab2" (show lab2f) @@ -644,30 +656,41 @@ bhash :: Word32 bhash = 23 +-- since the hashing is now done by hashable, is it worth checking +-- the hash values directly? + +-- copy of internal code in GraphMatch +toHash :: (Label lb) => Int -> lb -> Word32 +toHash s lbl = + fromIntegral $ + if labelIsVar lbl + then s `combine` 23 + else labelHash s lbl + l1hash, l4hash, l10hash :: Word32 -l1hash = 2524 -l4hash = -1302210307 -l10hash = 10836024 +l1hash = toHash 0 l1 +l4hash = toHash 0 l4 +l10hash = toHash 0 l10 l1hash2, l4hash2, l10hash2 :: Word32 -l1hash2 = 2524 -l4hash2 = -1302210307 -l10hash2 = 10836024 +l1hash2 = l1hash +l4hash2 = l4hash +l10hash2 = l10hash o1hash, o2hash, o3hash :: Word32 -o1hash = 2623 -o2hash = 2620 -o3hash = 2621 +o1hash = toHash 0 o1 +o2hash = toHash 0 o2 +o3hash = toHash 0 o3 p1hash, p2hash, p3hash :: Word32 -p1hash = 2624 -p2hash = 2627 -p3hash = 2626 +p1hash = toHash 0 p1 +p2hash = toHash 0 p2 +p3hash = toHash 0 p3 s1hash, s2hash, s3hash :: Word32 -s1hash = 2723 -s2hash = 2720 -s3hash = 2721 +s1hash = toHash 0 s1 +s2hash = toHash 0 s2 +s3hash = toHash 0 s3 lmap5 :: LabelMap LabelMem lmap5 = tstLabelMap 2 @@ -1066,9 +1089,10 @@ ec31test :: [EquivArgs] ec31test = - [ ((1,2623),[o1_1]) - , ((1,2624),[p1_1]) - , ((1,2723),[s1_1]) + sortBy (compare `on` (snd.fst)) + [ ((1,o1hash),[o1_1]) + , ((1,p1hash),[p1_1]) + , ((1,s1hash),[s1_1]) ] ec32 :: [EquivClass] @@ -1076,16 +1100,17 @@ ec32test :: [EquivArgs] ec32test = - [ ((1,2524),[l1_2]) - , ((1,2620),[o2_2]) - , ((1,2621),[o3_2]) - , ((1,2623),[o1_2]) - , ((1,2624),[p1_2]) - , ((1,2720),[s2_2]) - , ((1,2721),[s3_2]) - , ((1,2723),[s1_2]) - , ((1,10836024),[l10_2]) - , ((1,2992756989),[l4_2]) + sortBy (compare `on` (snd.fst)) + [ ((1,l1hash),[l1_2]) + , ((1,o2hash),[o2_2]) + , ((1,o3hash),[o3_2]) + , ((1,o1hash),[o1_2]) + , ((1,p1hash),[p1_2]) + , ((1,s2hash),[s2_2]) + , ((1,s3hash),[s3_2]) + , ((1,s1hash),[s1_2]) + , ((1,l10hash),[l10_2]) + , ((1,l4hash),[l4_2]) ] testEquivClass33_1, testEquivClass33_2 :: Test