swish 0.10.0.9 → 0.10.1.0
raw patch · 12 files changed
+149/−71 lines, 12 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- README.md +6/−0
- default.nix +4/−1
- shell.nix +4/−1
- src/Swish/RDF/Formatter/N3.hs +15/−5
- src/Swish/RDF/Formatter/Turtle.hs +15/−5
- src/Swish/RDF/Vocabulary.hs +16/−11
- swish.cabal +2/−2
- tests/RDFGraphTest.hs +9/−4
- tests/RDFProofContextTest.hs +15/−10
- tests/RDFQueryTest.hs +36/−22
- tests/VarBindingTest.hs +21/−10
CHANGELOG view
@@ -1,3 +1,9 @@+0.10.1.0:++ Support building with GHC 9.2. The Swish.Datatype module+ complains about non-exhaustive matches but it's in an+ irrefutable match so I'm not sure how to avoid this.+ 0.10.0.9: Support the semigroups 0.20 and initial support of the text 2.0
README.md view
@@ -100,3 +100,9 @@ % nix-shell ... nix-shell% cabal test++or++ % nix-shell --argstr compiler ghc921+ ...+ nix-shell% cabal test
default.nix view
@@ -1,1 +1,4 @@-(import ./release.nix {}).exe+{ compiler ? "ghc8107"+}:++(import ./release.nix { compiler = compiler; }).exe
shell.nix view
@@ -1,1 +1,4 @@-(import ./release.nix {}).shell+{ compiler ? "ghc8107"+}:++(import ./release.nix { compiler = compiler; }).shell
src/Swish/RDF/Formatter/N3.hs view
@@ -7,7 +7,7 @@ -- | -- Module : N3 -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2020 Douglas Burke+-- 2011, 2012, 2014, 2020, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -109,6 +109,7 @@ import Control.Monad.State (State, modify, get, gets, put, runState) import Data.Char (isDigit)+import Data.List (uncons) import Data.Word (Word32) #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)@@ -370,10 +371,19 @@ , bNodesCheck = bNodes } +-- A version of uncons for a list which is not empty but we haven't+-- encoded that invariant.+--+getNext :: [a] -> (a, [a])+getNext xs = case uncons xs of+ Just (a, as) -> (a, as)+ Nothing -> error "Invariant broken: list is empty"++ nextSubject :: Formatter RDFLabel nextSubject = changeState $ \st -> - let (a,b):sbs = subjs st+ let ((a,b), sbs) = getNext (subjs st) nst = st { subjs = sbs , props = b , objs = []@@ -383,7 +393,7 @@ nextProperty :: RDFLabel -> Formatter RDFLabel nextProperty _ = changeState $ \st ->- let (a,b):prs = props st+ let ((a,b), prs) = getNext (props st) nst = st { props = prs , objs = b }@@ -392,7 +402,7 @@ nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel nextObject _ _ = changeState $ \st ->- let ob:obs = objs st+ let (ob, obs) = getNext (objs st) nst = st { objs = obs } in (ob, nst) @@ -480,7 +490,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2020 Douglas Burke+-- 2011, 2012, 2014, 2020, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Formatter/Turtle.hs view
@@ -7,7 +7,7 @@ -- | -- Module : Turtle -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2018, 2019, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2018, 2019, 2020, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -97,6 +97,7 @@ import Control.Monad.State (State, modify, gets, runState) import Data.Char (isDigit)+import Data.List (uncons) import Data.Word (Word32) #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)@@ -289,10 +290,19 @@ , bNodesCheck = bNodes } +-- A version of uncons for a list which is not empty but we haven't+-- encoded that invariant.+--+getNext :: [a] -> (a, [a])+getNext xs = case uncons xs of+ Just (a, as) -> (a, as)+ Nothing -> error "Invariant broken: list is empty"++ nextSubject :: Formatter RDFLabel nextSubject = changeState $ \st -> - let (a,b):sbs = subjs st+ let ((a,b), sbs) = getNext (subjs st) nst = st { subjs = sbs , props = b , objs = []@@ -302,7 +312,7 @@ nextProperty :: RDFLabel -> Formatter RDFLabel nextProperty _ = changeState $ \st ->- let (a,b):prs = props st+ let ((a,b), prs) = getNext (props st) nst = st { props = prs , objs = b }@@ -311,7 +321,7 @@ nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel nextObject _ _ = changeState $ \st ->- let ob:obs = objs st+ let (ob, obs) = getNext (objs st) nst = st { objs = obs } in (ob, nst) @@ -381,7 +391,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2018, 2019, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2018, 2019, 2020, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Vocabulary.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Vocabulary--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -71,6 +71,8 @@ import Swish.RDF.Vocabulary.OWL import Swish.RDF.Vocabulary.XSD +import Control.Monad (guard)+ import Data.Char (isDigit, isAsciiLower) import Data.List (isPrefixOf) import Data.List.NonEmpty (NonEmpty(..))@@ -222,16 +224,19 @@ -- or obey any other syntactical restriction than given above. -- toLangTag :: T.Text -> Maybe LanguageTag-toLangTag lbl = - let tag = T.toLower lbl- toks = T.split (=='-') tag- in if all (\s -> let l = T.length s in l > 0 && l < 9) toks- then let primtag : subtags = toks- in if T.all isAsciiLower primtag && all (T.all (\c -> isAsciiLower c || isDigit c)) subtags- then Just $ LanguageTag lbl (NE.fromList toks)- else Nothing- else Nothing+toLangTag lbl = do+ let tag = T.toLower lbl+ toks = T.split (=='-') tag+ guard (all (\s -> let l = T.length s in l > 0 && l < 9) toks) + -- T.split can't return [] but the compiler doesn't know this+ case toks of+ primtag : subtags -> do+ guard (T.all isAsciiLower primtag && all (T.all (\c -> isAsciiLower c || isDigit c)) subtags)+ pure $ LanguageTag lbl (NE.fromList toks)++ [] -> Nothing+ -- | Convert a language tag back into text form. fromLangTag :: LanguageTag -> T.Text fromLangTag (LanguageTag f _) = f@@ -309,7 +314,7 @@ -------------------------------------------------------------------------------- ----- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
swish.cabal view
@@ -1,5 +1,5 @@ Name: swish-Version: 0.10.0.9+Version: 0.10.1.0 Stability: experimental License: LGPL-2.1 License-file: LICENSE @@ -94,7 +94,7 @@ Library Default-Language: Haskell2010 Build-Depends:- base >= 4.8 && < 4.16,+ base >= 4.8 && < 4.17, containers >= 0.5 && < 0.7, directory >= 1.0 && < 1.4, filepath >= 1.1 && < 1.5,
tests/RDFGraphTest.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : RDFGraphTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2017 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2017, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -670,6 +670,11 @@ -- Node generation tests ------------------------------------------------------------ +take3 :: [a] -> (a, a, a)+take3 (a : b : c : _) = (a, b, c)+take3 _ = error "Expected at least 3 elements"++ testNodeEq :: String -> RDFLabel -> RDFLabel -> Test testNodeEq = testCompare "testNodeEq:" @@ -678,10 +683,10 @@ tnn02 = newNode b1 [b1,b3,v1,v2] tnn03, tnn04, tnn05 :: RDFLabel-(tnn03 : tnn04 : tnn05 : _ ) = newNodes b1 [b1, b3, v1, v2]+(tnn03, tnn04, tnn05) = take3 $ newNodes b1 [b1, b3, v1, v2] tnn06, tnn07, tnn08 :: RDFLabel-(tnn06 : tnn07 : tnn08 : _ ) = newNodes s1 [b1,b3,v1,v2,tnns3]+(tnn06, tnn07, tnn08) = take3 $ newNodes s1 [b1,b3,v1,v2,tnns3] tnn09 :: RDFLabel tnn09 = newNodes l1 [b1,b3,v1,v2,tnns3] !! 2@@ -1609,7 +1614,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014 Douglas Burke +-- 2011, 2012, 2013, 2014, 2017, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
tests/RDFProofContextTest.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : RDFProofContextTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -110,15 +110,20 @@ makeSName :: String -> ScopedName makeSName nam = makeNSScopedName ns (fromJust (newLName (T.pack loc))) where- (pre,_:loc) = break (==':') nam- ns = case pre of- "rs_rdf" -> scopeRDF- "rs_rdfs" -> scopeRDFS- "rs_rdfd" -> scopeRDFD- "xsd_integer" -> namespaceXsdType "integer"- "xsd_string" -> namespaceXsdType "string"- _ -> error $ "makeSName: Unrecognized prefix in rule name: " ++ nam+ err = error $ "makeSName: Unrcognized prefix in rule name: " ++ nam+ (pre, post) = break (==':') nam+ loc = case post of+ "" -> err+ _:loc' -> loc' + ns = case pre of+ "rs_rdf" -> scopeRDF+ "rs_rdfs" -> scopeRDFS+ "rs_rdfd" -> scopeRDFD+ "xsd_integer" -> namespaceXsdType "integer"+ "xsd_string" -> namespaceXsdType "string"+ _ -> err+ -- Common definitions toURI :: String -> URI@@ -669,7 +674,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013 Douglas Burke+-- 2011, 2012, 2013, 2014, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
tests/RDFQueryTest.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : RDFQueryTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -120,6 +120,16 @@ result11b = prefix1 `mappend` "ex:s2 ex:r \"lit1\" . \n" result11c = prefix1 `mappend` "[ ex:r ex:o3 ] . \n" +-- Avoid incomplete-coverage warnings from ghc 9.2+get1 :: [x] -> x+get1 [x] = x+get1 _ = error "Invalid response - not a singleton"++get2 :: [x] -> (x, x)+get2 [x, y] = (x, y)+get2 _ = error "Invalid response - not a pair"++ var11 :: [RDFVarBinding] var11 = rdfQueryFind query11 graph1 @@ -721,8 +731,9 @@ res44 = rdfQueryBackSubs var44 result44 res44_1, res44_2 :: [(RDFGraph, [RDFLabel])]-[res44_1,res44_2] = res44+(res44_1, res44_2) = get2 res44 + -- test45: multiple substitutions used together -- -- (?a daughter ?b, ?a son ?c) => ?b brother ?c@@ -769,10 +780,10 @@ res45 = rdfQueryBackSubs var45 result45 res45_1 :: [(RDFGraph, [RDFLabel])]-[res45_1] = res45+res45_1 = get1 $ res45 res45_11, res45_12 :: (RDFGraph, [RDFLabel])-[res45_11,res45_12] = res45_1+(res45_11, res45_12) = get2 $ res45_1 -- test46: multiple ways to get solution --@@ -820,11 +831,11 @@ res46 = rdfQueryBackSubs var46 result46 res46_1, res46_2 :: [(RDFGraph, [RDFLabel])]-[res46_1,res46_2] = res46+(res46_1, res46_2) = get2 res46 res46_11, res46_21 :: (RDFGraph, [RDFLabel])-[res46_11] = res46_1-[res46_21] = res46_2+res46_11 = get1 res46_1+res46_21 = get1 res46_2 -- test47: multiple ways to multiple solutions --@@ -909,16 +920,19 @@ res47 = rdfQueryBackSubs var47 result47 res47_1, res47_2, res47_3, res47_4 :: [(RDFGraph, [RDFLabel])]-[res47_1,res47_2,res47_3,res47_4] = res47+(res47_1, res47_2, res47_3, res47_4) = case res47 of+ [a, b, c, d] -> (a, b, c, d)+ _ -> error "Expected 4 answers"+ res47_11, res47_12, res47_21, res47_22, res47_31, res47_32, res47_41, res47_42 :: (RDFGraph, [RDFLabel])-[res47_11,res47_12] = res47_1-[res47_21,res47_22] = res47_2-[res47_31,res47_32] = res47_3-[res47_41,res47_42] = res47_4+(res47_11, res47_12) = get2 res47_1+(res47_21, res47_22) = get2 res47_2+(res47_31, res47_32) = get2 res47_3+(res47_41, res47_42) = get2 res47_4 -- test48: redundant multiple ways to get solution --@@ -959,11 +973,11 @@ res48 = rdfQueryBackSubs var48 result48 res48_1, res48_2 :: [(RDFGraph, [RDFLabel])]-[res48_1,res48_2] = res48+(res48_1, res48_2) = get2 res48 res48_11, res48_21 :: (RDFGraph, [RDFLabel])-[res48_11] = res48_1-[res48_21] = res48_2+res48_11 = get1 res48_1+res48_21 = get1 res48_2 -- test49: goal not satisfiable by rule --@@ -1028,11 +1042,11 @@ res50 = rdfQueryBackSubs var50 result50 res50_1, res50_2 :: [(RDFGraph, [RDFLabel])]-[res50_1,res50_2] = res50+(res50_1, res50_2) = get2 res50 res50_11, res50_21 :: (RDFGraph, [RDFLabel])-[res50_11] = res50_1-[res50_21] = res50_2+res50_11 = get1 res50_1+res50_21 = get1 res50_2 filter50 :: RDFVarBindingFilter filter50 = varFilterNE (Var "b") (Var "c")@@ -1196,7 +1210,7 @@ res61 = rdfQueryBackSubsBlank var61 result61 res61a1, res61a2, res61a :: RDFGraph-[[res61a1,res61a2]] = res61+(res61a1, res61a2) = get2 $ get1 $ res61 res61a = merge res61a1 res61a2 -- 2. Instance query against 'graph2'@@ -1210,7 +1224,7 @@ res63 = rdfQuerySubs var62 res61a res63a :: RDFGraph-[res63a] = res63+res63a = get1 res63 -- 4. Repeat instance query against 'graph2' -- Query bindings should be null.@@ -1219,7 +1233,7 @@ var64 = rdfQueryInstance res63a graph2 var64a :: RDFVarBinding-[var64a] = var64+var64a = get1 var64 test6 :: Test test6 = @@ -1657,7 +1671,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013 Douglas Burke +-- 2011, 2012, 2013, 2014, 2018, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
tests/VarBindingTest.hs view
@@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : VarBindingTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2013 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2013, 2021 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -191,9 +191,15 @@ } +-- Avoid pattern-match errors from ghc 9.2+get1 :: [a] -> a+get1 [x] = x+get1 _ = error "Expected single-element list"++ vb1m1, vb2m1 :: VarBinding String Int-[vb1m1] = vbmApply vbm1 [vb1m]-[vb2m1] = vbmApply vbm1 [vb2m]+vb1m1 = get1 $ vbmApply vbm1 [vb1m]+vb2m1 = get1 $ vbmApply vbm1 [vb2m] -- Filter for bindings that define a vbm2 :: VarBindingModify String Int@@ -314,9 +320,14 @@ , vbmUsage = [[],["a"],["c"],["d"]] } +getJust :: Maybe x -> x+getJust (Just x) = x+getJust _ = error "Expected something, got Nothing"++ vbm34, vbm43 :: VarBindingModify String Int-Just vbm34 = vbmCompose vbm3 vbm4-Just vbm43 = vbmCompose vbm4 vbm3+vbm34 = getJust $ vbmCompose vbm3 vbm4+vbm43 = getJust $ vbmCompose vbm4 vbm3 vbm34vocab, vbm43vocab :: [String] vbm34vocab = [ "a", "b", "c", "d"]@@ -403,11 +414,11 @@ jvbmid1 = vbmCompose varBindingId vbm1 vb1m1id, vb2m1id, vb1mid1, vb2mid1 :: VarBinding String Int-[vb1m1id] = vbmApply (fromJust jvbm1id) [vb1m]-[vb2m1id] = vbmApply (fromJust jvbm1id) [vb2m]+vb1m1id = get1 $ vbmApply (fromJust jvbm1id) [vb1m]+vb2m1id = get1 $ vbmApply (fromJust jvbm1id) [vb2m] -[vb1mid1] = vbmApply (fromJust jvbmid1) [vb1m]-[vb2mid1] = vbmApply (fromJust jvbmid1) [vb2m]+vb1mid1 = get1 $ vbmApply (fromJust jvbmid1) [vb1m]+vb2mid1 = get1 $ vbmApply (fromJust jvbmid1) [vb2m] testVarComposeSuite :: Test testVarComposeSuite = @@ -797,7 +808,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2013 Douglas Burke+-- 2011, 2013, 2021 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.