diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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 @@ -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. diff --git a/src/Swish.hs b/src/Swish.hs --- a/src/Swish.hs +++ b/src/Swish.hs @@ -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 () diff --git a/src/Swish/Commands.hs b/src/Swish/Commands.hs --- a/src/Swish/Commands.hs +++ b/src/Swish/Commands.hs @@ -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 -------------------------------------------------------------------------------- diff --git a/src/Swish/Datatype.hs b/src/Swish/Datatype.hs --- a/src/Swish/Datatype.hs +++ b/src/Swish/Datatype.hs @@ -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. diff --git a/src/Swish/GraphClass.hs b/src/Swish/GraphClass.hs --- a/src/Swish/GraphClass.hs +++ b/src/Swish/GraphClass.hs @@ -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. diff --git a/src/Swish/GraphMatch.hs b/src/Swish/GraphMatch.hs --- a/src/Swish/GraphMatch.hs +++ b/src/Swish/GraphMatch.hs @@ -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) diff --git a/src/Swish/GraphPartition.hs b/src/Swish/GraphPartition.hs --- a/src/Swish/GraphPartition.hs +++ b/src/Swish/GraphPartition.hs @@ -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. diff --git a/src/Swish/Monad.hs b/src/Swish/Monad.hs --- a/src/Swish/Monad.hs +++ b/src/Swish/Monad.hs @@ -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. diff --git a/src/Swish/Proof.hs b/src/Swish/Proof.hs --- a/src/Swish/Proof.hs +++ b/src/Swish/Proof.hs @@ -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. diff --git a/src/Swish/QName.hs b/src/Swish/QName.hs --- a/src/Swish/QName.hs +++ b/src/Swish/QName.hs @@ -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. diff --git a/src/Swish/RDF/BuiltIn/Rules.hs b/src/Swish/RDF/BuiltIn/Rules.hs --- a/src/Swish/RDF/BuiltIn/Rules.hs +++ b/src/Swish/RDF/BuiltIn/Rules.hs @@ -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. diff --git a/src/Swish/RDF/ClassRestrictionRule.hs b/src/Swish/RDF/ClassRestrictionRule.hs --- a/src/Swish/RDF/ClassRestrictionRule.hs +++ b/src/Swish/RDF/ClassRestrictionRule.hs @@ -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. diff --git a/src/Swish/RDF/Datatype/XSD/Decimal.hs b/src/Swish/RDF/Datatype/XSD/Decimal.hs --- a/src/Swish/RDF/Datatype/XSD/Decimal.hs +++ b/src/Swish/RDF/Datatype/XSD/Decimal.hs @@ -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. 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 @@ -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. diff --git a/src/Swish/RDF/Formatter/Internal.hs b/src/Swish/RDF/Formatter/Internal.hs --- a/src/Swish/RDF/Formatter/Internal.hs +++ b/src/Swish/RDF/Formatter/Internal.hs @@ -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. 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 @@ -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 = "" @@ -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. diff --git a/src/Swish/RDF/Parser/Turtle.hs b/src/Swish/RDF/Parser/Turtle.hs --- a/src/Swish/RDF/Parser/Turtle.hs +++ b/src/Swish/RDF/Parser/Turtle.hs @@ -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 -( infixl 3 infixl 4 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. diff --git a/src/Swish/RDF/Query.hs b/src/Swish/RDF/Query.hs --- a/src/Swish/RDF/Query.hs +++ b/src/Swish/RDF/Query.hs @@ -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. diff --git a/src/Swish/RDF/Vocabulary.hs b/src/Swish/RDF/Vocabulary.hs --- a/src/Swish/RDF/Vocabulary.hs +++ b/src/Swish/RDF/Vocabulary.hs @@ -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. diff --git a/src/Swish/Rule.hs b/src/Swish/Rule.hs --- a/src/Swish/Rule.hs +++ b/src/Swish/Rule.hs @@ -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. diff --git a/src/Swish/Script.hs b/src/Swish/Script.hs --- a/src/Swish/Script.hs +++ b/src/Swish/Script.hs @@ -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 () diff --git a/src/Swish/VarBinding.hs b/src/Swish/VarBinding.hs --- a/src/Swish/VarBinding.hs +++ b/src/Swish/VarBinding.hs @@ -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. diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,5 @@ flags: {} packages: - '.' -resolver: lts-18.18 +# Match the version used in .gitlab-ci.yml +resolver: lts-18.28 diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -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.*,