swish 0.10.1.0 → 0.10.2.0
raw patch · 26 files changed
+327/−217 lines, 26 filesdep −old-localedep ~hashabledep ~timePVP ok
version bump matches the API change (PVP)
Dependencies removed: old-locale
Dependency ranges changed: hashable, time
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- src/Data/Interned/URI.hs +15/−5
- src/Swish.hs +2/−2
- src/Swish/Commands.hs +5/−5
- src/Swish/Datatype.hs +15/−15
- src/Swish/GraphClass.hs +13/−5
- src/Swish/GraphMatch.hs +11/−11
- src/Swish/GraphPartition.hs +21/−11
- src/Swish/Monad.hs +19/−5
- src/Swish/Proof.hs +18/−8
- src/Swish/QName.hs +14/−5
- src/Swish/RDF/BuiltIn/Rules.hs +3/−3
- src/Swish/RDF/ClassRestrictionRule.hs +6/−6
- src/Swish/RDF/Datatype/XSD/Decimal.hs +16/−16
- src/Swish/RDF/Datatype/XSD/Integer.hs +13/−13
- src/Swish/RDF/Formatter/Internal.hs +13/−5
- src/Swish/RDF/Graph.hs +9/−9
- src/Swish/RDF/Parser/Turtle.hs +15/−7
- src/Swish/RDF/Parser/Utils.hs +3/−3
- src/Swish/RDF/Query.hs +5/−5
- src/Swish/RDF/Vocabulary.hs +3/−3
- src/Swish/Rule.hs +16/−7
- src/Swish/Script.hs +47/−47
- src/Swish/VarBinding.hs +3/−3
- stack.yaml +2/−1
- swish.cabal +34/−17
CHANGELOG view
@@ -1,3 +1,9 @@+0.10.2.0:++ Check we can build with stack lts-19 (GHC 9.0) and spaces+ around operators to please GHC 9.2. Dropped support for+ time < 1.5 as it hasn't been tested for a long while.+ 0.10.1.0: Support building with GHC 9.2. The Swish.Datatype module
src/Data/Interned/URI.hs view
@@ -1,18 +1,22 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : URI--- Copyright : (c) 2011, 2012 Douglas Burke+-- Copyright : (c) 2011, 2012, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : CPP, TypeFamilies, FlexibleInstances+-- Portability : CPP, DerivingStrategies, FlexibleInstances, TypeFamilies -- -- Support interning URIs. --@@ -52,7 +56,13 @@ instance Interned InternedURI where type Uninterned InternedURI = URI- data Description InternedURI = DU !URI deriving (Eq) -- DU {-# UNPACK #-} !URI deriving (Eq) + data Description InternedURI = DU !URI+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq)+ describe = DU identify = InternedURI #if MIN_VERSION_intern(0,9,0)@@ -80,7 +90,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke+-- 2011, 2012, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish.hs view
@@ -228,7 +228,7 @@ -- validateCommand :: String -> Either (String, SwishStatus) SwishAction validateCommand cmd =- let (nam,more) = break (=='=') cmd+ let (nam,more) = break (== '=') cmd arg = drop 1 more marg = if null arg then Nothing else Just arg @@ -246,7 +246,7 @@ "-o" -> wrap swishOutput "-b" -> validateBase cmd marg "-s" -> wrap swishScript- _ -> Left ("Invalid command line argument: "++cmd, SwishArgumentError)+ _ -> Left ("Invalid command line argument: " ++ cmd, SwishArgumentError) -- | Execute the given set of actions. swishCommands :: [SwishAction] -> SwishStateIO ()
src/Swish/Commands.hs view
@@ -140,7 +140,7 @@ -> Handle -> SwishStateIO () swishOutputDiffs diffs fnam hnd = do- lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))+ lift $ hPutStrLn hnd ("Graph differences: " ++ show (length diffs)) mapM_ (swishOutputDiff fnam hnd) (zip [1..] diffs) swishOutputDiff :: (Label lb) =>@@ -149,7 +149,7 @@ -> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb))) -> SwishStateIO () swishOutputDiff fnam hnd (diffnum,(part1,part2)) = do- lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")+ lift $ hPutStrLn hnd ("---- Difference " ++ show diffnum ++ " ----") lift $ hPutStr hnd "Graph 1:" swishOutputPart fnam hnd part1 lift $ hPutStr hnd "Graph 2:"@@ -219,7 +219,7 @@ case parseScriptFromText (Just buri) inp of Left err -> do let inName = maybe "standard input" ("file " ++) mfpath- swishError ("Script syntax error in " ++ inName ++ ": "++err) SwishDataInputError+ swishError ("Script syntax error in " ++ inName ++ ": " ++ err) SwishDataInputError return [] Right scs -> return scs@@ -297,7 +297,7 @@ o <- sOpen fnam ReadMode case o of Left _ -> do- swishError ("Cannot open file: "++fnam) SwishDataAccessError+ swishError ("Cannot open file: " ++ fnam) SwishDataAccessError return Nothing Right hnd -> readFromHandle hnd $ Just ("file: " ++ fnam)@@ -379,7 +379,7 @@ then return $ Just (hnd, True) else do lift $ hClose hnd- swishError ("Cannot write to file: "++fnam) SwishDataAccessError+ swishError ("Cannot write to file: " ++ fnam) SwishDataAccessError return Nothing --------------------------------------------------------------------------------
src/Swish/Datatype.hs view
@@ -8,7 +8,7 @@ -- | -- Module : Datatype -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2018, 2019 Douglas Burke+-- 2011, 2012, 2018, 2019, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -867,24 +867,24 @@ -- |'altArgs' support for unary functions: function applicator unaryFnApp :: UnaryFnApply a-unaryFnApp p (f1,n) args = apf (args!!n)+unaryFnApp p (f1,n) args = apf (args !! n) where apf (Just a) = if p r then Just [r] else Nothing where r = f1 a apf Nothing = Just [] -- |'altArgs' support for binary functions: function descriptor type-type BinaryFnDescr a = (a->a->a,Int,Int)+type BinaryFnDescr a = (a -> a -> a, Int, Int) -- |'altArgs' support for binary functions: function descriptor table type-type BinaryFnTable a = [(a->Bool,[BinaryFnDescr a])]+type BinaryFnTable a = [(a -> Bool, [BinaryFnDescr a])] -- |'altArgs' support for binary functions: function applicator type type BinaryFnApply a =- (a->Bool) -> BinaryFnDescr a -> [Maybe a] -> Maybe [a]+ (a -> Bool) -> BinaryFnDescr a -> [Maybe a] -> Maybe [a] -- |'altArgs' support for binary functions: function applicator binaryFnApp :: BinaryFnApply a-binaryFnApp p (f,n1,n2) args = apf (args!!n1) (args!!n2)+binaryFnApp p (f,n1,n2) args = apf (args !! n1) (args !! n2) where apf (Just a1) (Just a2) = if p r then Just [r] else Nothing where r = f a1 a2@@ -892,21 +892,21 @@ -- |'altArgs' support for binary function with provision for indicating -- inconsistent supplied values: function descriptor type-type BinMaybeFnDescr a = (a->a->Maybe [a],Int,Int)+type BinMaybeFnDescr a = (a -> a ->Maybe [a], Int, Int) -- |'altArgs' support for binary function with provision for indicating -- inconsistent supplied values: function descriptor table type-type BinMaybeFnTable a = [(a->Bool,[BinMaybeFnDescr a])]+type BinMaybeFnTable a = [(a -> Bool, [BinMaybeFnDescr a])] -- |'altArgs' support for binary function with provision for indicating -- inconsistent supplied values: function applicator type type BinMaybeFnApply a =- (a->Bool) -> BinMaybeFnDescr a -> [Maybe a] -> Maybe [a]+ (a -> Bool) -> BinMaybeFnDescr a -> [Maybe a] -> Maybe [a] -- |'altArgs' support for binary function with provision for indicating -- inconsistent supplied values: function applicator binMaybeFnApp :: BinMaybeFnApply a-binMaybeFnApp p (f,n1,n2) args = apf (args!!n1) (args!!n2)+binMaybeFnApp p (f,n1,n2) args = apf (args !! n1) (args !! n2) where apf (Just a1) (Just a2) = if pm r then r else Nothing where@@ -946,13 +946,13 @@ -- See test cases in spike-altargs.hs for an example. -- -- Function descriptor type-type ListFnDescr a = (a->a->a,a,a->a->a,Int)+type ListFnDescr a = (a -> a -> a, a, a -> a -> a, Int) -- |Function table type-type ListFnTable a = [(a->Bool,[ListFnDescr a])]+type ListFnTable a = [(a -> Bool, [ListFnDescr a])] -- |'altArgs' support for list functions: function applicator type-type ListFnApply a = (a->Bool) -> ListFnDescr a -> [Maybe a] -> Maybe [a]+type ListFnApply a = (a -> Bool) -> ListFnDescr a -> [Maybe a] -> Maybe [a] -- |'altArgs' support for list functions: function applicator listFnApp :: ListFnApply a@@ -960,7 +960,7 @@ | n == 0 = app $ foldr (apf f) (Just [z]) args | otherwise =- app $ apf g a0 (foldr (apf f) (Just [z]) (args `deleteIndex` (n-1)))+ app $ apf g a0 (foldr (apf f) (Just [z]) (args `deleteIndex` (n - 1))) where apf :: (a->a->a) -> Maybe a -> Maybe [a] -> Maybe [a] apf fn (Just a1) (Just [a2]) = Just [fn a1 a2]@@ -1039,7 +1039,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2018 Douglas Burke+-- 2011, 2012, 2018, 2019, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/GraphClass.hs view
@@ -2,18 +2,22 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveTraversable #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : GraphClass -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2016, 2020 Douglas Burke+-- 2011, 2012, 2016, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiParamTypeClasses+-- Portability : CPP, DeriveTraversable, DerivingStrategies, MultiParamTypeClasses -- -- This module defines a Labelled Directed Graph and Label classes, -- and the Arc datatype.@@ -152,7 +156,11 @@ , arcPred :: lb -- ^ The predicate (property) of the arc. , arcObj :: lb -- ^ The object of the arc. }- deriving (Eq, Functor, F.Foldable, T.Traversable)+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq, Functor, F.Foldable, T.Traversable) -- | A set - or graph - of arcs. type ArcSet lb = S.Set (Arc lb)@@ -184,7 +192,7 @@ instance (Show lb) => Show (Arc lb) where show (Arc lb1 lb2 lb3) =- "("++ show lb1 ++","++ show lb2 ++","++ show lb3 ++")"+ "(" ++ show lb1 ++ "," ++ show lb2 ++ "," ++ show lb3 ++ ")" -- | Identify arcs. type Selector lb = Arc lb -> Bool@@ -204,7 +212,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2016, 2020 Douglas Burke+-- 2011, 2012, 2016, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/GraphMatch.hs view
@@ -7,7 +7,7 @@ -- | -- Module : GraphMatch -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2016, 2018, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -188,8 +188,8 @@ makeScopedArc scope = fmap (ScopedLabel scope) instance (Label lb) => Label (ScopedLabel lb) where- getLocal lab = error $ "getLocal for ScopedLabel: "++show lab- makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam+ getLocal lab = error $ "getLocal for ScopedLabel: " ++ show lab+ makeLabel locnam = error $ "makeLabel for ScopedLabel: " ++ locnam labelIsVar (ScopedLabel _ lab) = labelIsVar lab labelHash seed (ScopedLabel scope lab) | labelIsVar lab = seed `hashWithSalt` scope@@ -396,7 +396,7 @@ -- NOTE: final test is call of external matchable function glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ] in- assert (ev1==ev2) -- "GraphMatch2: Equivalence class value mismatch" $+ assert (ev1 == ev2) -- "GraphMatch2: Equivalence class value mismatch" $ $ try glp -- this was in Swish.Utils.MiscHelpers along with a simple hash-based function@@ -410,8 +410,8 @@ -- showLabelMap :: (Label lb) => LabelMap lb -> String showLabelMap (LabelMap gn lmap) =- "LabelMap gen="++ Prelude.show gn ++", map="++- foldl' (++) "" (map (("\n "++) . Prelude.show) es)+ "LabelMap gen=" ++ Prelude.show gn ++ ", map=" +++ foldl' (++) "" (map (("\n " ++) . Prelude.show) es) where es = M.toList lmap @@ -454,7 +454,7 @@ -- but with an incremented generation number. -- newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb-newGenerationMap (LabelMap g lvs) = LabelMap (g+1) lvs+newGenerationMap (LabelMap g lvs) = LabelMap (g + 1) lvs -- | Scan label list, assigning initial label map values, -- adding new values to the label map supplied.@@ -537,7 +537,7 @@ -- then `True`, otherwise `False`. reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =- assert (gen1==gen2) -- "Label map generation mismatch"+ assert (gen1 == gen2) -- "Label map generation mismatch" (LabelMap gen1 lm',ecpairs',newPart,matchPart) where LabelMap gen1 lm1 =@@ -580,13 +580,13 @@ remapLabels gs lmap@(LabelMap gen _) ls = LabelMap gen' $ M.fromList newEntries where- gen' = gen+1+ 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 = fromIntegral $ hashVal gen l -- otherwise rehash (to disentangle collisions)+ | labelIsVar l = mapAdjacent l -- adjacency classifies variable labels+ | otherwise = hashVal gen l -- otherwise rehash (to disentangle collisions) TODO: BRANCH IS UNTESTED -- mapAdjacent used to use `rem` hashModulus mapAdjacent l = hashModulus `hashWithSalt` sum (sigsOver l)
src/Swish/GraphPartition.hs view
@@ -1,14 +1,20 @@+{-# LANGUAGE CPP #-}++#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : GraphPartition--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : CPP, DerivingStrategies -- -- This module contains functions for partitioning a graph into subgraphs -- that rooted from different subject nodes.@@ -50,7 +56,11 @@ -- 'PartObj' constructors. data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]- deriving (Eq, Show)+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq, Show) -- | Returns all the arcs in the partitioned graph. getArcs :: PartitionedGraph lb -> [Arc lb]@@ -104,7 +114,7 @@ partitionShow :: (Label lb) => GraphPartition lb -> String partitionShow (PartObj ob) = show ob partitionShow (PartSub sb (pr :| prs)) =- "("++ show sb ++ " " ++ showpr pr ++ concatMap ((" ; "++).showpr) prs ++ ")"+ "(" ++ show sb ++ " " ++ showpr pr ++ concatMap ((" ; " ++).showpr) prs ++ ")" where showpr (a,b) = show a ++ " " ++ show b @@ -118,9 +128,9 @@ -> String partitionShowP _ (PartObj ob) = show ob partitionShowP pref (PartSub sb (pr :| prs)) =- pref++"("++ show sb ++ " " ++ showpr pr ++ concatMap (((pref++" ; ")++).showpr) prs ++ ")"+ pref ++ "(" ++ show sb ++ " " ++ showpr pr ++ concatMap (((pref ++ " ; ") ++ ).showpr) prs ++ ")" where- showpr (a,b) = show a ++ " " ++ partitionShowP (pref++" ") b+ showpr (a,b) = show a ++ " " ++ partitionShowP (pref ++ " ") b ------------------------------------------------------------ -- Creating partitioned graphs@@ -213,7 +223,7 @@ makePartitions1 (sub:subs) = do ph <- makePartitions2 sub pt <- makePartitions1 subs- return $ ph++pt+ return $ ph ++ pt makePartitions2 :: (Eq lb) =>@@ -265,7 +275,7 @@ -> PState lb [LabelledArcs lb] pickIntSubject sub = do (s1,s2,s3) <- get- let varsub = removeBy (\x->(x==).fst) sub s3+ let varsub = removeBy (\x -> (x ==).fst) sub s3 case varsub of Just (vs, s3new) -> put (s1,s2,s3new) >> return [vs] Nothing -> return []@@ -276,7 +286,7 @@ PState lb [LabelledArcs lb] pickVarSubject sub = do (s1,s2,s3) <- get- let varsub = removeBy (\x->(x==).fst) sub s2+ let varsub = removeBy (\x -> (x ==).fst) sub s2 case varsub of Just (vs, s2new) -> put (s1,s2new,s3) >> return [vs] _ -> return []@@ -551,7 +561,7 @@ comps = [ (cmp a1 a2,a2t) | (a2,a2t) <- removeEach a2s ] maybeResult (Nothing,_) = Nothing maybeResult (Just ds,a2t) = Just (ds,a2t)- morediffs xds xa1h xa1t xa2t = (xds++xds1,xa1h++xa1r,xa2r)+ morediffs xds xa1h xa1t xa2t = (xds ++ xds1, xa1h ++ xa1r, xa2r) where (xds1,xa1r,xa2r) = listDifferences cmp xa1t xa2t choose [] = Nothing@@ -575,7 +585,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke+-- 2011, 2012, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/Monad.hs view
@@ -1,15 +1,21 @@+{-# LANGUAGE CPP #-}++#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Monad -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke+-- 2011, 2012, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : CPP, DerivingStrategies -- -- Composed state and IO monad for Swish --@@ -62,7 +68,11 @@ Turtle -- ^ Turtle format | N3 -- ^ N3 format | NT -- ^ NTriples format- deriving Eq+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ Eq instance Show SwishFormat where show N3 = "N3"@@ -93,7 +103,11 @@ | SwishDataAccessError -- ^ data access error | SwishArgumentError -- ^ command-line argument error | SwishExecutionError -- ^ error executing a Swish script- deriving (Eq, Enum)+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq, Enum) instance Show SwishStatus where show SwishSuccess = "Success."@@ -234,7 +248,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke +-- 2011, 2012, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/Proof.hs view
@@ -1,15 +1,21 @@+{-# LANGUAGE CPP #-}++#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Proof -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2016 Douglas Burke+-- 2011, 2016, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : CPP, DerivingStrategies -- -- This module defines a framework for constructing proofs -- over some expression form. It is intended to be used@@ -47,7 +53,11 @@ { stepRule :: Rule ex -- ^ Inference rule used , stepAnt :: [Formula ex] -- ^ Antecedents of inference rule , stepCon :: Formula ex -- ^ Named consequence of inference rule- } deriving Show+ } deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ Show -- |Proof is a structure that presents a chain of rule applications -- that yield a result expression from a given expression@@ -168,7 +178,7 @@ explainProof1 rules prev (st:steps) res = case explainStep rules prev st of Nothing -> explainProof1 rules (formExpr (stepCon st):prev) steps res- Just ex -> Just ("Invalid step: "++show (formName $ stepCon st)++": "++ex)+ Just ex -> Just ("Invalid step: " ++ show (formName $ stepCon st) ++ ": " ++ ex) -- | A proof step is valid if rule is in list of rules -- and the antecedents are sufficient to obtain the conclusion@@ -198,7 +208,7 @@ errors = catMaybes -- Rule name is one of supplied rules, and [ require (ruleName srul `elem` map ruleName rules)- ("rule "++show (ruleName srul)++" not present")+ ("rule " ++ show (ruleName srul) ++ " not present") -- Antecedent expressions are all previously accepted expressions , require (S.fromList sant `S.isSubsetOf` S.fromList prev) -- (sant `subset` prev) "antecedent not axiom or previous result"@@ -258,7 +268,7 @@ showsStep :: (ShowLines ex) => String -> Step ex -> ShowS showsStep newline s = showsFormula newline (stepCon s) . showString newline .- showString (" (by ["++rulename++"] from "++antnames++")")+ showString (" (by [" ++ rulename ++ "] from " ++ antnames ++ ")") where rulename = show . ruleName $ stepRule s antnames = showNames $ map (show . formName) (stepAnt s)@@ -272,11 +282,11 @@ -- |Return a string representing a single name. showName :: String -> String-showName n = "["++n++"]"+showName n = "[" ++ n ++ "]" -------------------------------------------------------------------------------- ----- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2016, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/QName.hs view
@@ -1,16 +1,21 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : QName--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2020 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : OverloadedStrings+-- Portability : CPP, DerivingStrategies, OverloadedStrings -- -- This module defines an algebraic datatype for qualified names (QNames), -- which represents a 'URI' as the combination of a namespace 'URI'@@ -75,7 +80,11 @@ This is all rather experimental. -} newtype LName = LName T.Text- deriving (Eq, Ord)+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq, Ord) instance Show LName where show (LName t) = show t@@ -208,7 +217,7 @@ in case uf of "#" -> q0 '#':xs -> start (uri {uriFragment = "#"}) `fmap` newLName (T.pack xs)- "" -> case break (=='/') (reverse up) of+ "" -> case break (== '/') (reverse up) of ("",_) -> q0 -- path ends in / or is empty (_,"") -> q0 -- path contains no / (rlname,rpath) -> @@ -273,7 +282,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2020 Douglas Burke+-- 2011, 2012, 2013, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/BuiltIn/Rules.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Rules--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -71,7 +71,7 @@ -- filter1 f (lb:_) = makeVarFilterModift $ f lb -- filter1 f lbs = makeVarFilterModify $ f (head lbs)- filter2 f lbs = makeVarFilterModify $ f (head lbs) (lbs!!1)+ filter2 f lbs = makeVarFilterModify $ f (head lbs) (lbs !! 1) -- filterN f lbs = makeVarFilterModify $ f ... ------------------------------------------------------------@@ -132,7 +132,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke+-- 2011, 2012, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/ClassRestrictionRule.hs view
@@ -7,7 +7,7 @@ -- | -- Module : ClassRestrictionRule -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2018 Douglas Burke+-- 2011, 2012, 2014, 2018, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -174,7 +174,7 @@ c = fromMaybe NoNode $ vbMap vb (Var "c") p = fromMaybe NoNode $ vbMap vb (Var "p") r = fromMaybe NoNode $ vbMap vb (Var "r")- cs = filter (>0) $ map fromInteger $+ cs = filter (> 0) $ map fromInteger $ rdfFindPredInt c resRdfdMaxCardinality gr ps = rdfFindList gr p @@ -315,12 +315,12 @@ -- deriveTuple :: ClassRestriction -> [RDFLabel]- -> [([Maybe RDFLabel],[RDFLabel])]+ -> [([Maybe RDFLabel], [RDFLabel])] deriveTuple restriction ft = map (tosnd ft) $ minima partCompareListMaybe $ filter derives partials where- partials = mapM (\x -> [Nothing,Just x]) ft- derives = ([ft]==) . fromJust . crFunc restriction+ partials = mapM (\x -> [Nothing, Just x]) ft+ derives = ([ft] ==) . fromJust . crFunc restriction tosnd = flip (,) -- Helper function to apply a restriction to selected information from@@ -529,7 +529,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2018 Douglas Burke+-- 2011, 2012, 2014, 2018, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Datatype/XSD/Decimal.hs view
@@ -7,7 +7,7 @@ -- | -- Module : Decimal -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011 William Waites, 2011, 2012, 2014 Douglas Burke+-- 2011 William Waites, 2011, 2012, 2014, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -157,7 +157,7 @@ relXsdDecimalAbs :: DatatypeRel Double relXsdDecimalAbs = mkDecRel2 "abs" (const True)- [ ( (>=0), [ (abs,1) ] )+ [ ( (>= 0), [ (abs,1) ] ) , ( const True, [ (id,0), (negate,0) ] ) ] @@ -192,7 +192,7 @@ relXsdDecimalPower = mkDecRel3 "power" (const True) [ ( const True, [ ((**),1,2) ] ) , ( const True, [ ] )- , ( (>=0), [ ] )+ , ( (>= 0), [ ] ) ] liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool@@ -290,11 +290,11 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 + v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2+v3]+ f1 [v2,v3] = [v2 + v3] f1 _ = []- f2 [v1,vi] = [v1-vi]+ f2 [v1,vi] = [v1 - vi] f2 _ = [] modXsdDecimalDiff :: RDFDatatypeMod Double@@ -304,13 +304,13 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 - v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2-v3]+ f1 [v2,v3] = [v2 - v3] f1 _ = []- f2 [v1,v3] = [v1+v3]+ f2 [v1,v3] = [v1 + v3] f2 _ = []- f3 [v1,v2] = [v2-v1]+ f3 [v1,v2] = [v2 - v1] f3 _ = [] modXsdDecimalProd :: RDFDatatypeMod Double@@ -320,11 +320,11 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 * v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2*v3]+ f1 [v2,v3] = [v2 * v3] f1 _ = []- f2 [v1,vi] = [v1/vi]+ f2 [v1,vi] = [v1 / vi] f2 _ = [] modXsdDecimalPower :: RDFDatatypeMod Double@@ -334,9 +334,9 @@ , dmAppf = makeVmod21 } where- f0 vs@[v1,v2,v3] = if v1 == (v2**v3 :: Double) then vs else []+ f0 vs@[v1,v2,v3] = if v1 == (v2 ** v3 :: Double) then vs else [] f0 _ = []- f1 [v2,v3] = [v2**v3 :: Double]+ f1 [v2,v3] = [v2 ** v3 :: Double] f1 _ = [] modXsdDecimalEq, modXsdDecimalNe, modXsdDecimalLt, modXsdDecimalLe, modXsdDecimalGt, modXsdDecimalGe :: RDFDatatypeMod Double @@ -466,7 +466,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011 William Waites, 2011, 2012 Douglas Burke, +-- 2011 William Waites, 2011, 2012, 2014, 2022 Douglas Burke, -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Datatype/XSD/Integer.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Integer--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2018 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2018, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -178,7 +178,7 @@ relXsdIntegerAbs :: DatatypeRel Integer relXsdIntegerAbs = mkIntRel2 "abs" (const True)- [ ( (>=0), [ (abs,1) ] )+ [ ( (>= 0), [ (abs,1) ] ) , ( const True, [ (id,0), (negate,0) ] ) ] @@ -225,7 +225,7 @@ relXsdIntegerPower = mkIntRel3maybe "power" (const True) [ ( const True, [ (fmap (:[]) `c2` intPower,1,2) ] ) , ( const True, [ ] )- , ( (>=0), [ ] )+ , ( (>= 0), [ ] ) ] liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool@@ -324,11 +324,11 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 + v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2+v3]+ f1 [v2,v3] = [v2 + v3] f1 _ = []- f2 [v1,vi] = [v1-vi]+ f2 [v1,vi] = [v1 - vi] f2 _ = [] modXsdIntegerDiff :: RDFDatatypeMod Integer@@ -338,13 +338,13 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 - v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2-v3]+ f1 [v2,v3] = [v2 - v3] f1 _ = []- f2 [v1,v3] = [v1+v3]+ f2 [v1,v3] = [v1 + v3] f2 _ = []- f3 [v1,v2] = [v2-v1]+ f3 [v1,v2] = [v2 - v1] f3 _ = [] modXsdIntegerProd :: RDFDatatypeMod Integer@@ -354,9 +354,9 @@ , dmAppf = makeVmod21inv } where- f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []+ f0 vs@[v1,v2,v3] = if v1 == v2 * v3 then vs else [] f0 _ = []- f1 [v2,v3] = [v2*v3]+ f1 [v2,v3] = [v2 * v3] f1 _ = [] f2 [v1,vi] = [q | r == 0] where (q,r) = quotRem v1 vi@@ -510,7 +510,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2018 Douglas Burke+-- 2011, 2012, 2014, 2018, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Formatter/Internal.hs view
@@ -1,18 +1,22 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Internal -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2016, 2018, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : CPP, OverloadedStrings+-- Portability : CPP, DerivingStrategies, OverloadedStrings -- -- Utility routines. --@@ -122,7 +126,11 @@ -- | The context for label creation. -- data LabelContext = SubjContext | PredContext | ObjContext- deriving (Eq, Show)+ deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ (Eq, Show) -- | A generator for BNode labels. data NodeGenState = Ngs@@ -405,7 +413,7 @@ n = if has3Q || (not hasNL && not hasSQ) then 1 else 3 qch = B.fromString (replicate n '"')- qst = B.fromText $ quoteT (n==1) txt+ qst = B.fromText $ quoteT (n == 1) txt in mconcat [qch, qst, qch] @@ -701,7 +709,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2016, 2018, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Graph.hs view
@@ -9,7 +9,7 @@ -- | -- Module : Graph -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020. 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -298,7 +298,7 @@ | otherwise = quote1Str st ++ "^^" ++ show nam -} - show (Blank ln) = "_:"++ln+ show (Blank ln) = "_:" ++ ln show (Var ln) = '?' : ln show NoNode = "<NoNode>" @@ -487,9 +487,9 @@ textToRealFloat :: (RealFloat a, Read a) => (a -> Maybe a) -> T.Text -> Maybe a textToRealFloat conv = rconv where- rconv "NaN" = Just (0.0/0.0) -- how best to create a NaN?- rconv "INF" = Just (1.0/0.0) -- ditto for Infinity- rconv "-INF" = Just ((-1.0)/0.0)+ rconv "NaN" = Just (0.0 / 0.0) -- how best to create a NaN?+ rconv "INF" = Just (1.0 / 0.0) -- ditto for Infinity+ rconv "-INF" = Just ((-1.0) / 0.0) rconv ival -- xsd semantics allows "2." but Haskell syntax does not. | T.null ival = Nothing@@ -686,7 +686,7 @@ -- for this purpose. -- showCanon :: RDFLabel -> String-showCanon (Res sn) = "<"++show (getScopedNameURI sn)++">"+showCanon (Res sn) = "<" ++ show (getScopedNameURI sn) ++ ">" showCanon (Lit st) = show st showCanon (LangLit st lang) = quote1Str st ++ "@" ++ T.unpack (fromLangTag lang) showCanon (TypedLit st dt) = quote1Str st ++ "^^" ++ show (getScopedNameURI dt)@@ -1380,7 +1380,7 @@ grShowList p (g:gs) = showChar '[' . showString (grShow pp g) . showl gs where showl [] = showChar ']' -- showString $ "\n" ++ p ++ "]"- showl (h:hs) = showString (",\n "++p++grShow pp h) . showl hs+ showl (h:hs) = showString (",\n " ++ p ++ grShow pp h) . showl hs pp = ' ':p grShow :: (Label lb) => String -> NSGraph lb -> String@@ -1559,7 +1559,7 @@ splitnodeid = break isDigit trynodes :: (Label lb) => (String, Word32) -> [lb]-trynodes (nr,nx) = [ makeLabel (nr++show n) | n <- iterate (+1) nx ]+trynodes (nr,nx) = [ makeLabel (nr ++ show n) | n <- iterate (+ 1) nx ] {- trybnodes :: (Label lb) => (String,Int) -> [lb]@@ -1619,7 +1619,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Parser/Turtle.hs view
@@ -1,17 +1,21 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Turtle--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018, 2020 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : CPP, OverloadedStrings+-- Portability : CPP, DerivingStrategies, OverloadedStrings -- -- This Module implements a Turtle parser, returning a -- new 'RDFGraph' consisting of triples and namespace information parsed from@@ -136,7 +140,11 @@ , prefixUris :: NamespaceMap -- namespace prefix mapping table , baseUri :: URI -- base URI , nodeGen :: Word32 -- blank node id generator- } deriving Show+ } deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ Show -- | Functions to update TurtleState vector (use with stUpdate) @@ -367,7 +375,7 @@ Parser s a -> String -- ^ Error message to add (a new line is added after the message) -> Parser s a-(<?) p m = adjustErr p ((m++"\n")++)+(<?) p m = adjustErr p ((m ++ "\n") ++) -- Applicative's <* et al are infixl 4, with <|> infixl 3 infixl 4 <?@@ -746,7 +754,7 @@ clean = go 0 edl where go n acc [] = (n, acc [])- go n acc ('.':xs) = go (n+1) acc xs + go n acc ('.':xs) = go (n + 1) acc xs go 0 acc (x:xs) = go 0 (snocdl x acc) xs go n acc (x:xs) = go 0 (appenddl acc (snocdl x (replicatedl n '.'))) xs @@ -788,7 +796,7 @@ _leadingSign :: TurtleParser (Maybe Bool) _leadingSign = do ms <- optional (satisfy (`elem` ("+-"::String)))- return $ (=='+') `fmap` ms+ return $ (== '+') `fmap` ms {- For when we tried to create a canonical representation.@@ -1047,7 +1055,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2013, 2014, 2018, 2020 Douglas Burke+-- 2011, 2012, 2013, 2014, 2018, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Parser/Utils.hs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Utils--- 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, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -169,7 +169,7 @@ -- | Match the character. char :: Char -> Parser s Char-char c = satisfy (==c)+char c = satisfy (== c) -- | Match the character, ignoring the result. ichar :: Char -> Parser s ()@@ -355,7 +355,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2014, 2018 Douglas Burke+-- 2011, 2012, 2014, 2018, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/RDF/Query.hs view
@@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Query--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -509,15 +509,15 @@ -- |Test if statement has given subject rdfSubjEq :: RDFLabel -> RDFTriple -> Bool-rdfSubjEq s = (s==) . arcSubj+rdfSubjEq s = (s ==) . arcSubj -- |Test if statement has given predicate rdfPredEq :: RDFLabel -> RDFTriple -> Bool-rdfPredEq p = (p==) . arcPred+rdfPredEq p = (p ==) . arcPred -- |Test if statement has given object rdfObjEq :: RDFLabel -> RDFTriple -> Bool-rdfObjEq o = (o==) . arcObj+rdfObjEq o = (o ==) . arcObj {- -- |Find statements with given subject@@ -656,7 +656,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke +-- 2011, 2012, 2014, 2022 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, 2021 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -226,7 +226,7 @@ toLangTag :: T.Text -> Maybe LanguageTag toLangTag lbl = do let tag = T.toLower lbl- toks = T.split (=='-') tag+ 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@@ -314,7 +314,7 @@ -------------------------------------------------------------------------------- ----- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021 Douglas Burke+-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/Rule.hs view
@@ -1,16 +1,21 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#if (__GLASGOW_HASKELL__ >= 802)+{-# LANGUAGE DerivingStrategies #-}+#endif+ -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Rule--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : OverloadedStrings+-- Portability : CPP, DerivingStrategies, OverloadedStrings -- -- This module defines a framework for defining inference rules -- over some expression form. It is intended to be used with@@ -57,7 +62,11 @@ data Formula ex = Formula { formName :: ScopedName -- ^ Name used for formula in proof chain , formExpr :: ex -- ^ Named formula value- } deriving Show+ } deriving+#if (__GLASGOW_HASKELL__ >= 802)+ stock+#endif+ Show -- |Define equality of formulae as equality of formula names instance Eq (Formula ex) where@@ -114,7 +123,7 @@ -> Formula ex -- ^ formula -> ShowS showsFormula newline f =- showsWidth 16 ("["++show (formName f)++"] ") .+ showsWidth 16 ("[" ++ show (formName f) ++ "] ") . showls (newline ++ replicate 16 ' ') (formExpr f) ------------------------------------------------------------@@ -168,7 +177,7 @@ r1 <= r2 = ruleName r1 <= ruleName r2 instance Show (Rule ex) where- show rl = "Rule "++show (ruleName rl)+ show rl = "Rule " ++ show (ruleName rl) -- | A set of rules labelled with their name. type RuleMap ex = M.Map ScopedName (Rule ex)@@ -212,7 +221,7 @@ -- |Show a string left justified in a field of at least the specified -- number of characters width. showsWidth :: Int -> String -> ShowS-showsWidth wid str more = str++replicate pad ' '++more+showsWidth wid str more = str ++ replicate pad ' ' ++ more where pad = wid - length str @@ -220,7 +229,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012 Douglas Burke+-- 2011, 2012, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
src/Swish/Script.hs view
@@ -464,12 +464,12 @@ ScopedName -> [SwishStateIO (Either String RDFGraph)] -> SwishStateIO () ssAddGraph nam gf =- let errmsg = "Graph/list not added: "++show nam++"; "+ let errmsg = "Graph/list not added: " ++ show nam ++ "; " in do { esg <- sequence gf -- [Either String RDFGraph] ; let egs = sequence esg -- Either String [RDFGraph] ; let fgs = case egs of- Left er -> setError (errmsg++er)+ Left er -> setError (errmsg ++ er) Right gs -> modGraphs (M.insert nam gs) ; modify fgs }@@ -481,14 +481,14 @@ ssGetFormula nam = gets find where find st = case findFormula nam st of- Nothing -> Left ("Formula not present: "++show nam)+ Nothing -> Left ("Formula not present: " ++ show nam) Just gr -> Right gr ssGetList :: ScopedName -> SwishStateIO (Either String [RDFGraph]) ssGetList nam = gets find where find st = case findGraph nam st of- Nothing -> Left ("Graph or list not present: "++show nam)+ Nothing -> Left ("Graph or list not present: " ++ show nam) Just grs -> Right grs ssRead :: ScopedName -> Maybe URI -> SwishStateIO ()@@ -508,18 +508,18 @@ ssWriteList muri gf comment = do esgs <- gf case esgs of- Left er -> modify $ setError ("Cannot write list: "++er)+ Left er -> modify $ setError ("Cannot write list: " ++ er) Right [] -> putResourceData Nothing (B.fromLazyText (L.concat ["# ", L.pack comment, "\n+ Swish: Writing empty list"])) Right [gr] -> ssWriteGraph muri gr comment Right grs -> mapM_ writegr (zip [(0::Int)..] grs) where writegr (n,gr) = ssWriteGraph (murin muri n) gr- ("["++show n++"] "++comment)+ ("[" ++ show n ++ "] " ++ comment) murin Nothing _ = Nothing murin (Just uri) n = let rp = reverse $ uriPath uri- (rLastSet, rRest) = break (=='/') rp- (before, after) = break (=='.') $ reverse rLastSet+ (rLastSet, rRest) = break (== '/') rp+ (before, after) = break (== '.') $ reverse rLastSet newPath = reverse rRest ++ "/" ++ before ++ show n ++ after in case rLastSet of "" -> error $ "Invalid URI (path ends in /): " ++ show uri@@ -549,14 +549,14 @@ ScopedName -> [SwishStateIO (Either String RDFGraph)] -> SwishStateIO () ssMerge nam gfs =- let errmsg = "Graph merge not defined: "++show nam++"; "+ let errmsg = "Graph merge not defined: " ++ show nam ++ "; " in do { ssReportLabel "Merge" (show nam) ; esg <- sequence gfs -- [Either String RDFGraph] ; let egs = sequence esg -- Either String [RDFGraph] ; let fgs = case egs of- Left er -> setError (errmsg++er)- Right [] -> setError (errmsg++"No graphs to merge")+ Left er -> setError (errmsg ++ er)+ Right [] -> setError (errmsg ++ "No graphs to merge") Right gs -> modGraphs (M.insert nam [g]) where g = foldl1 merge gs ; modify fgs@@ -578,12 +578,12 @@ ; g1 <- ssGetList n1 ; g2 <- ssGetList n2 ; case (g1,g2) of- (Left er,_) -> modify $ setError (comment++er1++"\n "++er)- (_,Left er) -> modify $ setError (comment++er1++"\n "++er)+ (Left er,_) -> modify $ setError (comment ++ er1 ++ "\n " ++ er)+ (_,Left er) -> modify $ setError (comment ++ er1 ++ "\n " ++ er) (Right gr1,Right gr2) -> when (S.fromList gr1 /= S.fromList gr2) $ modify $- setError (comment++":\n Graph "++show n1- ++" differs from "++show n2++".")+ setError (comment ++ ":\n Graph " ++ show n1+ ++ " differs from " ++ show n2 ++ ".") } ssAssertIn :: ScopedName -> ScopedName -> String -> SwishStateIO ()@@ -595,12 +595,12 @@ ; g1 <- ssGetGraph n1 ; g2 <- ssGetList n2 ; case (g1,g2) of- (Left er,_) -> modify $ setError (comment++er1++"\n "++er)- (_,Left er) -> modify $ setError (comment++er2++"\n "++er)+ (Left er,_) -> modify $ setError (comment ++ er1 ++ "\n " ++ er)+ (_,Left er) -> modify $ setError (comment ++ er2 ++ "\n " ++ er) (Right gr,Right gs) -> unless (gr `elem` gs) $ modify $- setError (comment++":\n Graph "++show n1- ++" not a member of "++show n2)+ setError (comment ++ ":\n Graph " ++ show n1+ ++ " not a member of " ++ show n2) } -- Note: this is probably incomplete, though it should work in simple cases.@@ -631,9 +631,9 @@ ; evms <- sequence vmfs -- [Either String RDFVarBindingModify] ; let vms = sequence evms :: Either String [RDFVarBindingModify] ; let frl = case (ags,cg,vms) of- (Left er,_,_) -> setError (errmsg1++er)- (_,Left er,_) -> setError (errmsg2++er)- (_,_,Left er) -> setError (errmsg3++er)+ (Left er,_,_) -> setError (errmsg1 ++ er)+ (_,Left er,_) -> setError (errmsg2 ++ er)+ (_,_,Left er) -> setError (errmsg3 ++ er) (Right agrs,Right cgr,Right vbms) -> let newRule = makeRDFClosureRule rn agrs cgr@@ -649,7 +649,7 @@ ssFindVarModify (nam,lbs) = gets $ \st -> case findOpenVarModify nam st of Just ovbm -> Right (ovbm lbs)- Nothing -> Left ("Undefined modifier: "++show nam)+ Nothing -> Left ("Undefined modifier: " ++ show nam) ssDefineRuleset :: ScopedName@@ -669,8 +669,8 @@ ; rles <- erlf -- [Either String RDFRule] ; let erls = sequence rles :: Either String [RDFRule] ; let frs = case (eags,erls) of- (Left er,_) -> setError (errmsg1++er)- (_,Left er) -> setError (errmsg2++er)+ (Left er,_) -> setError (errmsg1 ++ er)+ (_,Left er) -> setError (errmsg2 ++ er) (Right ags,Right rls) -> modRulesets (M.insert (getRulesetNamespace rs) rs) where@@ -682,7 +682,7 @@ ssFindRule nam = gets find where find st = case findRule nam st of- Nothing -> Left ("Rule not found: "++show nam)+ Nothing -> Left ("Rule not found: " ++ show nam) Just rl -> Right rl ssDefineConstraints ::@@ -704,8 +704,8 @@ -- [Either String RDFDatatype] ; let edts = sequence edtf :: Either String [RDFDatatype] ; let frs = case (ecgr,edts) of- (Left er,_) -> setError (errmsg1++er)- (_,Left er) -> setError (errmsg2++er)+ (Left er,_) -> setError (errmsg1 ++ er)+ (_,Left er) -> setError (errmsg2 ++ er) (Right cgr,Right dts) -> modRulesets (M.insert (getRulesetNamespace rs) rs) where@@ -718,7 +718,7 @@ ssFindDatatype nam = gets find where find st = case findDatatype nam st of- Nothing -> Left ("Datatype not found: "++show nam)+ Nothing -> Left ("Datatype not found: " ++ show nam) Just dt -> Right dt @@ -738,7 +738,7 @@ errmsg3 = "Error in proof step(s): " errmsg4 = "Error in proof goal: " errmsg5 = "Proof not satisfied: "- proofname = " (Proof "++show pn++")"+ proofname = " (Proof " ++ show pn ++ ")" in do { let rs1 = map ssFindRuleset sns :: [SwishStateIO (Either String RDFRuleset)] ; rs2 <- sequence rs1 -- [Either String RDFRuleset]@@ -749,10 +749,10 @@ ; let ests = sequence st2 :: Either String [RDFProofStep] ; erg <- rgf -- Either String RDFFormula ; let proof = case (erss,eig,ests,erg) of- (Left er,_,_,_) -> Left (errmsg1++er++proofname)- (_,Left er,_,_) -> Left (errmsg2++er++proofname)- (_,_,Left er,_) -> Left (errmsg3++er++proofname)- (_,_,_,Left er) -> Left (errmsg4++er++proofname)+ (Left er,_,_,_) -> Left (errmsg1 ++ er ++ proofname)+ (_,Left er,_,_) -> Left (errmsg2 ++ er ++ proofname)+ (_,_,Left er,_) -> Left (errmsg3 ++ er ++ proofname)+ (_,_,_,Left er) -> Left (errmsg4 ++ er ++ proofname) (Right rss, Right ig, Right sts, Right rg) -> Right (makeRDFProof rss ig rg sts) ; when False $ case proof of@@ -766,8 +766,8 @@ (Left er) -> setError er (Right pr) -> case explainProof pr of- Nothing -> setInfo (infmsg1++show pn)- Just ex -> setError (errmsg5++show pn++", "++ex)+ Nothing -> setInfo (infmsg1 ++ show pn)+ Just ex -> setError (errmsg5 ++ show pn ++ ", " ++ ex) {- if not $ checkProof pr then setError (errmsg5++show pn)@@ -795,9 +795,9 @@ ; let eags = sequence esag :: Either String [RDFFormula] ; ecg <- ecgf -- Either String RDFFormula ; let est = case (mrul,eags,ecg) of- (Nothing,_,_) -> Left (errmsg1++show rn)- (_,Left er,_) -> Left (errmsg2++er)- (_,_,Left er) -> Left (errmsg3++er)+ (Nothing,_,_) -> Left (errmsg1 ++ show rn)+ (_,Left er,_) -> Left (errmsg2 ++ er)+ (_,_,Left er) -> Left (errmsg3 ++ er) (Just rul,Right ags,Right cg) -> Right $ makeRDFProofStep rul ags cg ; return est@@ -819,8 +819,8 @@ ; aesg <- sequence agfs -- [Either String RDFGraph] ; let eags = sequence aesg :: Either String [RDFGraph] ; let fcr = case (erl,eags) of- (Left er,_) -> setError (errmsg1++er)- (_,Left er) -> setError (errmsg2++er)+ (Left er,_) -> setError (errmsg1 ++ er)+ (_,Left er) -> setError (errmsg2 ++ er) (Right rl,Right ags) -> modGraphs (M.insert cn [cg]) where@@ -835,10 +835,10 @@ ssFindRulesetRule sn rn = gets find where find st = case findRuleset sn st of- Nothing -> Left ("Ruleset not found: "++show sn)+ Nothing -> Left ("Ruleset not found: " ++ show sn) Just rs -> find1 rs find1 rs = case getRulesetRule rn rs of- Nothing -> Left ("Rule not in ruleset: "++show sn++": "++show rn)+ Nothing -> Left ("Rule not in ruleset: " ++ show sn ++ ": " ++ show rn) Just rl -> Right rl ssFindRuleset ::@@ -846,7 +846,7 @@ ssFindRuleset sn = gets find where find st = case findRuleset sn st of- Nothing -> Left ("Ruleset not found: "++show sn)+ Nothing -> Left ("Ruleset not found: " ++ show sn) Just rs -> Right rs ssBwdChain ::@@ -864,8 +864,8 @@ do { erl <- ssFindRulesetRule sn rn ; ecg <- cgf -- Either String RDFGraph ; let fcr = case (erl,ecg) of- (Left er,_) -> setError (errmsg1++er)- (_,Left er) -> setError (errmsg2++er)+ (Left er,_) -> setError (errmsg1 ++ er)+ (_,Left er) -> setError (errmsg2 ++ er) (Right rl,Right cg) -> modGraphs (M.insert an ags) where@@ -895,7 +895,7 @@ ios <- lift . CE.try $ maybe toStdout toUri muri case ios of Left ioe -> modify $ setError- ("Error writing graph: "+++ ("Error writing graph: " ++ IO.ioeGetErrorString ioe) Right _ -> return ()
src/Swish/VarBinding.hs view
@@ -8,7 +8,7 @@ -- | -- Module : VarBinding -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012, 2014, 2015, 2016, 2018, 2020 Douglas Burke+-- 2011, 2012, 2014, 2015, 2016, 2018, 2020, 2022 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke@@ -356,7 +356,7 @@ -- the first modifier with the second modifier, or an empty list if -- the modifiers are incompatible. compatibleUsage voc1 use1 use2 =- [ u1++u2 | u2 <- use2, null (voc1 `intersect` u2), u1 <- use1 ]+ [ u1 ++ u2 | u2 <- use2, null (voc1 `intersect` u2), u1 <- use1 ] -- |Find all compatible compositions of a list of variable binding -- modifiers for a given set of supplied bound variables.@@ -528,7 +528,7 @@ -------------------------------------------------------------------------------- -- -- (c) 2003, Graham Klyne, 2009 Vasili I Galchin,--- 2011, 2012, 2020 Douglas Burke+-- 2011, 2012, 2020, 2022 Douglas Burke -- All rights reserved. -- -- This file is part of Swish.
stack.yaml view
@@ -1,4 +1,5 @@ flags: {} packages: - '.'-resolver: lts-18.18+# Match the version used in .gitlab-ci.yml+resolver: lts-18.28
swish.cabal view
@@ -1,10 +1,10 @@ Name: swish-Version: 0.10.1.0+Version: 0.10.2.0 Stability: experimental License: LGPL-2.1 License-file: LICENSE Author: Graham Klyne - GK@ninebynine.org-Copyright: (c) 2003, 2004 G. Klyne; 2009 Vasili I Galchin; 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Doug Burke; All rights reserved.+Copyright: (c) 2003, 2004 G. Klyne; 2009 Vasili I Galchin; 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 Doug Burke; All rights reserved. Maintainer: dburke@cfa.harvard.edu Category: Semantic Web Synopsis: A semantic web toolkit. @@ -99,16 +99,14 @@ directory >= 1.0 && < 1.4, filepath >= 1.1 && < 1.5, -- Early versions of hashable 1.2 are problematic- hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.5),+ hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.6), intern >= 0.8 && < 1.0, mtl >= 2 && < 3,- -- old-locale is only needed if time < 1.5 - old-locale == 1.0.*, polyparse >= 1.6 && < 1.14, text >= 0.11 && < 2.1, -- I don't think 1.9.0 will work and it was quickly replaced -- so do not support it - time (>= 1.1 && < 1.9) || (>= 1.9.1 && < 1.14)+ time (>= 1.5 && < 1.9) || (>= 1.9.1 && < 1.14) if flag(network-uri) build-depends: network-uri >= 2.6 && < 2.8@@ -116,17 +114,38 @@ build-depends: network-uri < 2.6 , network >= 2.4 && < 2.6 + -- Taken from https://twitter.com/ChShersh/status/1459829796087738375+ -- except for the orphans warning+ --+ ghc-options: -Wall+ -fno-warn-orphans++ if impl(ghc >= 8.0)+ -- I assume these are added in 8.0+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies+ -fwrite-ide-info+ -hiedir=.hie+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages+ if impl(ghc >= 9.0)+ ghc-options: -Winvalid-haddock+ if impl(ghc >= 9.2)+ ghc-options: -Wredundant-bang-patterns+ -Woperator-whitespace+ if impl(ghc < 8.0.0)- ghc-options:- -Wall -fno-warn-orphans build-depends: semigroups >= 0.16 && < 0.21- else- if impl(ghc < 8.8.0)- ghc-options:- -Wall -fno-warn-orphans -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances- else- ghc-options:- -Wall -fno-warn-orphans -Wcompat -Wnoncanonical-monad-instances -- if flag(developer) -- ghc-options: -Werror@@ -379,8 +398,6 @@ base, containers, HUnit,- -- old-locale is only needed if time < 1.5 - old-locale, swish, test-framework, test-framework-hunit == 0.3.*,