From 1a3b60e76bceedbca426feea74a657186488f9b9 Mon Sep 17 00:00:00 2001 From: John Pavel Date: Wed, 23 Jan 2019 21:10:47 +0000 Subject: [PATCH 1/2] Hlint cleanups --- .hlint.yaml | 65 +++++++++++++++++++ bench/MainCriterion.hs | 4 +- rdf-tests | 2 +- src/Data/RDF/Graph/AdjHashMap.hs | 2 +- src/Data/RDF/Graph/HashMapSP.hs | 2 +- src/Data/RDF/Graph/TList.hs | 2 +- src/Data/RDF/IRI.hs | 26 ++++---- src/Data/RDF/Query.hs | 3 +- src/Data/RDF/Types.hs | 12 ++-- src/Text/RDF/RDF4H/NTriplesParser.hs | 6 +- src/Text/RDF/RDF4H/ParserUtils.hs | 2 +- src/Text/RDF/RDF4H/TurtleParser.hs | 11 ++-- src/Text/RDF/RDF4H/XmlParser.hs | 4 +- testsuite/tests/Data/RDF/PropertyTests.hs | 17 +++-- .../tests/Text/RDF/RDF4H/XmlParser_Test.hs | 5 +- testsuite/tests/W3C/Manifest.hs | 4 +- testsuite/tests/W3C/RdfXmlTest.hs | 4 +- testsuite/tests/W3C/TurtleTest.hs | 4 +- 18 files changed, 119 insertions(+), 56 deletions(-) create mode 100644 .hlint.yaml diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..3f5ae3b --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,65 @@ +# HLint configuration file +# https://github.com/ndmitchell/hlint +########################## + +# This file contains a template configuration file, which is typically +# placed as .hlint.yaml in the root of your project + + +# Specify additional command line arguments +# +# - arguments: [--color, --cpp-simple, -XQuasiQuotes] + + +# Control which extensions/flags/modules/functions can be used +# +# - extensions: +# - default: false # all extension are banned by default +# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used +# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module +# +# - flags: +# - {name: -w, within: []} # -w is allowed nowhere +# +# - modules: +# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' +# - {name: Control.Arrow, within: []} # Certain modules are banned entirely +# +# - functions: +# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules + + +# Add custom hints for this project +# +# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar" +# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x} + + +# Turn on hints that are off by default +# +# Ban "module X(module X) where", to require a real export list +# - warn: {name: Use explicit module export list} +# +# Replace a $ b $ c with a . b $ c +# - group: {name: dollar, enabled: true} +# +# Generalise map to fmap, ++ to <> +# - group: {name: generalise, enabled: true} + + +# Ignore some builtin hints +# - ignore: {name: Use let} +# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules + + +# Define some custom infix operators +# - fixity: infixr 3 ~^#^~ + + +# To generate a suitable file for HLint do: +# $ hlint --default > .hlint.yaml + +- ignore: {name: Eta reduce} +- ignore: {name: Redundant bracket} +- ignore: {name: Reduce duplication} +- ignore: {name: Use camelCase} diff --git a/bench/MainCriterion.hs b/bench/MainCriterion.hs index ffa8d67..69f3f67 100644 --- a/bench/MainCriterion.hs +++ b/bench/MainCriterion.hs @@ -150,8 +150,8 @@ addRemoveTriples lbl triples emptyGr populatedGr = addTriples :: Rdf a => (Triples,RDF a) -> RDF a addTriples (triples,emptyGr) = - foldr (\t g -> addTriple g t) emptyGr triples + foldr (flip addTriple) emptyGr triples removeTriples :: Rdf a => (Triples,RDF a) -> RDF a removeTriples (triples,populatedGr) = - foldr (\t g -> removeTriple g t) populatedGr triples + foldr (flip removeTriple) populatedGr triples diff --git a/rdf-tests b/rdf-tests index e24f243..b3136e9 160000 --- a/rdf-tests +++ b/rdf-tests @@ -1 +1 @@ -Subproject commit e24f243f79087a61a1b1aa72f5c7c27470155c33 +Subproject commit b3136e909c6f1bfa550290bfb6cc41a29f2dc40d diff --git a/src/Data/RDF/Graph/AdjHashMap.hs b/src/Data/RDF/Graph/AdjHashMap.hs index 4c93c9f..467e89e 100644 --- a/src/Data/RDF/Graph/AdjHashMap.hs +++ b/src/Data/RDF/Graph/AdjHashMap.hs @@ -105,7 +105,7 @@ instance Rdf AdjHashMap where -- where subjPredMaps = HashMap.toList spoMap -- in concatMap (\t -> show t ++ "\n") ts -showGraph' :: RDF AdjHashMap -> [Char] +showGraph' :: RDF AdjHashMap -> String showGraph' ((AdjHashMap ((spoMap, _), _, _))) = let ts = concatMap (uncurry tripsSubj) subjPredMaps where subjPredMaps = HashMap.toList spoMap diff --git a/src/Data/RDF/Graph/HashMapSP.hs b/src/Data/RDF/Graph/HashMapSP.hs index 4bc6a95..1c243e4 100644 --- a/src/Data/RDF/Graph/HashMapSP.hs +++ b/src/Data/RDF/Graph/HashMapSP.hs @@ -49,7 +49,7 @@ instance Rdf HashSP where -- let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap -- in concatMap (\t -> show t ++ "\n") ts -showGraph' :: RDF HashSP -> [Char] +showGraph' :: RDF HashSP -> String showGraph' (HashSP (tsMap,_,_)) = let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap in concatMap (\t -> show t ++ "\n") ts diff --git a/src/Data/RDF/Graph/TList.hs b/src/Data/RDF/Graph/TList.hs index 7c76435..632129e 100644 --- a/src/Data/RDF/Graph/TList.hs +++ b/src/Data/RDF/Graph/TList.hs @@ -70,7 +70,7 @@ instance Rdf TList where query = query' showGraph = showGraph' -showGraph' :: RDF TList -> [Char] +showGraph' :: RDF TList -> String showGraph' gr = concatMap (\t -> show t ++ "\n") (expandTriples gr) prefixMappings' :: RDF TList -> PrefixMappings diff --git a/src/Data/RDF/IRI.hs b/src/Data/RDF/IRI.hs index 28fdcc5..d901792 100644 --- a/src/Data/RDF/IRI.hs +++ b/src/Data/RDF/IRI.hs @@ -19,12 +19,12 @@ module Data.RDF.IRI ) where import Data.Semigroup (Semigroup(..)) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (maybe, isJust) import Data.Functor import Data.List (intersperse) import Control.Applicative import Control.Monad (guard) -import Control.Arrow ((***), (&&&), (>>>)) +import Control.Arrow (first, (&&&), (>>>)) import Data.Char (isAlpha, isDigit, isAlphaNum, toUpper, toLower) import Data.Text (Text) import qualified Data.Text as T @@ -95,18 +95,18 @@ data SchemaError -- [TODO] use Builder serializeIRI :: IRIRef -> Text serializeIRI (IRIRef s a p q f) = mconcat - [ fromMaybe mempty (scheme <$> s) - , fromMaybe mempty (authority <$> a) + [ maybe mempty scheme s + , maybe mempty authority a , path p - , fromMaybe mempty (query <$> q) - , fromMaybe mempty (fragment <$> f)] + , maybe mempty query q + , maybe mempty fragment f ] where scheme (Scheme s') = s' <> ":" authority (Authority u (Host h) p') = mconcat [ "//" - , fromMaybe mempty (userInfo <$> u) + , maybe mempty userInfo u , h - , fromMaybe mempty (port <$> p') ] + , maybe mempty port p' ] userInfo (UserInfo u) = u <> "@" port (Port p') = (":" <>) . T.pack . show $ p' path (Path p') = p' @@ -123,7 +123,7 @@ parseRelIRI :: Text -> Either String IRIRef parseRelIRI = P.parseOnly $ irelativeRefParser <* (P.endOfInput "Unexpected characters at the end") validateIRI :: Text -> Either String Text -validateIRI t = const t <$> parseIRI t +validateIRI t = t <$ parseIRI t -- | IRI parsing and resolution according to algorithm 5.2 from RFC3986 -- See: http://www.ietf.org/rfc/rfc3986.txt @@ -270,7 +270,7 @@ ipathRootlessParser' = mconcat <$> sequence [isegmentNzParser, ipathAbEmptyParse -- ipath-empty = 0 ipathEmptyParser :: Parser (Maybe Authority, Path) -ipathEmptyParser = const (Nothing, mempty) <$> ipathEmptyParser' +ipathEmptyParser = (Nothing, mempty) <$ ipathEmptyParser' ipathEmptyParser' :: Parser Text ipathEmptyParser' = P.string mempty "Empty path" @@ -406,7 +406,7 @@ ipV6AddressParser = do h16 = parseBetween 1 4 (P.takeWhile isHexaDigit) ipNotElided (leading, lengthL) = guard (lengthL == 7 && isDecOctet (last leading)) *> partialIpV4 <|> - guard (lengthL == 8) *> pure mempty + (guard (lengthL == 8) $> mempty) ipElided (_, lengthL) = do guard $ lengthL <= 8 elision <- P.string "::" @@ -476,10 +476,10 @@ isSubDelims c = c `elem` ("!$&'()*+,;=" :: String) iauthWithPathParser :: Parser (Maybe Authority, Path) iauthWithPathParser = do void (P.string "//") - curry (Just *** id) <$> iauthorityParser <*> ipathAbEmptyParser + curry (first Just) <$> iauthorityParser <*> ipathAbEmptyParser isHexaDigit :: Char -> Bool -isHexaDigit c = (c >= '0' && c <= '9') || +isHexaDigit c = (isDigit c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') diff --git a/src/Data/RDF/Query.hs b/src/Data/RDF/Query.hs index 2cbe131..f7a8e1e 100644 --- a/src/Data/RDF/Query.hs +++ b/src/Data/RDF/Query.hs @@ -20,6 +20,7 @@ module Data.RDF.Query ( import Prelude hiding (pred) import Data.List +import Data.Maybe (fromMaybe) import Data.RDF.Types import qualified Data.RDF.Namespace as NS import Data.Text (Text) @@ -156,7 +157,7 @@ expandNode _ n = n -- Also expands "a" to "http://www.w3.org/1999/02/22-rdf-syntax-ns#type". expandURI :: PrefixMappings -> Text -> Text expandURI _ "a" = NS.mkUri NS.rdf "type" -expandURI pms iri = maybe iri id $ foldl' f Nothing (NS.toPMList pms) +expandURI pms iri = fromMaybe iri $ foldl' f Nothing (NS.toPMList pms) where f :: Maybe Text -> (Text, Text) -> Maybe Text f x (p, u) = x <|> (T.append u <$> T.stripPrefix (T.append p ":") iri) diff --git a/src/Data/RDF/Types.hs b/src/Data/RDF/Types.hs index 47b4cde..062ea6f 100644 --- a/src/Data/RDF/Types.hs +++ b/src/Data/RDF/Types.hs @@ -188,7 +188,7 @@ uriValidate = either (const Nothing) Just . isRdfURI -- |Same as 'uriValidate', but on 'String' rather than 'Text' uriValidateString :: String -> Maybe String -uriValidateString = liftA T.unpack . uriValidate . fromString +uriValidateString = fmap T.unpack . uriValidate . fromString isRdfURI :: Text -> Either ParseError Text isRdfURI t = parse (iriFragment <* eof) ("Invalid URI: " ++ T.unpack t) t @@ -624,12 +624,10 @@ canonicalizerTable = doubleUri = "http://www.w3.org/2001/XMLSchema#double" _integerStr, _decimalStr, _doubleStr :: Text -> Text -_integerStr t = - if T.length t == 1 - then t - else if T.head t == '0' - then _integerStr (T.tail t) - else t +_integerStr t + | T.length t == 1 = t + | T.head t == '0' = _integerStr (T.tail t) + | otherwise = t -- exponent: [eE] ('-' | '+')? [0-9]+ -- ('-' | '+') ? ( [0-9]+ '.' [0-9]* exponent | '.' ([0-9])+ exponent | ([0-9])+ exponent ) diff --git a/src/Text/RDF/RDF4H/NTriplesParser.hs b/src/Text/RDF/RDF4H/NTriplesParser.hs index 4f765bb..b7ad3ec 100644 --- a/src/Text/RDF/RDF4H/NTriplesParser.hs +++ b/src/Text/RDF/RDF4H/NTriplesParser.hs @@ -13,7 +13,7 @@ module Text.RDF.RDF4H.NTriplesParser import Prelude hiding (readFile) import Data.Semigroup ((<>)) -import Data.Char (isDigit, isLetter, isAlphaNum) +import Data.Char (isDigit, isLetter, isAlphaNum, isAsciiUpper, isAsciiLower) import Control.Applicative import Control.Monad (void) @@ -165,8 +165,8 @@ nt_blank_node_label = do -- [157s] PN_CHARS_BASE ::= [A-Z] | [a-z] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x02FF] | [#x0370-#x037D] | [#x037F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] nt_pn_chars_base :: CharParsing m => m Char nt_pn_chars_base = try $ satisfy isBaseChar - where isBaseChar c = (c >= 'A' && c <= 'Z') - || (c >= 'a' && c <= 'z') + where isBaseChar c = (isAsciiUpper c) + || (isAsciiLower c) || (c >= '\x00C0' && c <= '\x00D6') || (c >= '\x00D8' && c <= '\x00F6') || (c >= '\x00F8' && c <= '\x02FF') diff --git a/src/Text/RDF/RDF4H/ParserUtils.hs b/src/Text/RDF/RDF4H/ParserUtils.hs index f17ad71..0c9cdd0 100644 --- a/src/Text/RDF/RDF4H/ParserUtils.hs +++ b/src/Text/RDF/RDF4H/ParserUtils.hs @@ -28,7 +28,7 @@ _parseURL parseFunc url = do case ex of (HttpExceptionRequest _req content) -> case content of - ConnectionTimeout -> do + ConnectionTimeout -> return $ errResult "Connection timed out" _ -> return $ errResult ("HttpExceptionRequest content: " ++ show content) (InvalidUrlException{}) -> diff --git a/src/Text/RDF/RDF4H/TurtleParser.hs b/src/Text/RDF/RDF4H/TurtleParser.hs index 08b1485..9d1559a 100644 --- a/src/Text/RDF/RDF4H/TurtleParser.hs +++ b/src/Text/RDF/RDF4H/TurtleParser.hs @@ -24,6 +24,7 @@ import Text.RDF.RDF4H.NTriplesParser import Text.Parsec (runParser, ParseError) import qualified Data.Text as T import Data.Sequence (Seq, (|>)) +import Data.Functor (($>)) import qualified Data.Foldable as F import Control.Monad import Text.Parser.Char @@ -176,7 +177,7 @@ t_sparql_base = do updateBaseUrl (Just $ Just newBaseIri) t_verb :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m () -t_verb = try t_predicate <|> (char 'a' *> pure rdfTypeNode) >>= setPredicate +t_verb = try t_predicate <|> (char 'a' $> rdfTypeNode) >>= setPredicate -- grammar rule: [11] predicate ::= iri t_predicate :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node @@ -199,7 +200,7 @@ t_pn_local = do xs <- option "" $ try $ do let recsve = (t_pn_chars_str <|> string ":" <|> t_plx) <|> (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." <* lookAhead (try recsve))) <|> - (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." *> notFollowedBy t_ws *> pure ".")) + (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." *> notFollowedBy t_ws $> ".")) concat <$> many recsve pure (T.pack (x ++ xs)) where @@ -235,7 +236,7 @@ t_subject = iri <|> t_blankNode <|> t_collection >>= setSubject -- [137s] BlankNode ::= BLANK_NODE_LABEL | ANON t_blankNode :: (CharParsing m, MonadState ParseState m) => m Node t_blankNode = do - genID <- try t_blank_node_label <|> (t_anon *> pure mempty) + genID <- try t_blank_node_label <|> (t_anon $> mempty) mp <- currGenIdLookup maybe (newBN genID) getExistingBN (Map.lookup genID mp) where @@ -297,7 +298,7 @@ t_collection = withConstantSubjectPredicate $ void (many t_ws) return root where - empty_list = lookAhead (char ')') *> return rdfNilNode + empty_list = lookAhead (char ')') $> rdfNilNode non_empty_list = do ns <- sepEndBy1 element (some t_ws) addTripleForObject rdfNilNode @@ -507,7 +508,7 @@ updateBaseUrl val = _modifyState val no no no no no -- combines get_current and increment into a single function nextIdCounter :: MonadState ParseState m => m Integer nextIdCounter = get >>= \(bUrl, dUrl, i, pms, s, p, ts, genMap) -> - put (bUrl, dUrl, i+1, pms, s, p, ts, genMap) *> pure i + put (bUrl, dUrl, i+1, pms, s, p, ts, genMap) $> i nextBlankNode :: MonadState ParseState m => m Node nextBlankNode = BNodeGen . fromIntegral <$> nextIdCounter diff --git a/src/Text/RDF/RDF4H/XmlParser.hs b/src/Text/RDF/RDF4H/XmlParser.hs index a371d42..b5e5761 100644 --- a/src/Text/RDF/RDF4H/XmlParser.hs +++ b/src/Text/RDF/RDF4H/XmlParser.hs @@ -102,7 +102,7 @@ instance Exception ParserException -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. parseFile' :: (Rdf a) => Maybe BaseUrl -> Maybe Text -> String -> IO (Either ParseFailure (RDF a)) parseFile' bUrl dUrl fpath = - TIO.readFile fpath >>= return . parseXmlRDF bUrl dUrl + parseXmlRDF bUrl dUrl <$> TIO.readFile fpath -- |Parse the document at the given location URL as an XML document, using an optional @BaseUrl@ -- as the base URI, and using the given document URL as the URI of the XML document itself. @@ -438,7 +438,7 @@ my_expandURI -- |Make a UNode from an absolute string mkUNode :: forall a. (ArrowIf a) => a String Node mkUNode = choiceA [ (arr (isJust . unodeValidate . T.pack)) :-> (arr (unode . T.pack)) - , arr (\_ -> True) :-> arr (\uri -> throw (ParserException ("Invalid URI: " ++ uri))) + , arr (const True) :-> arr (\uri -> throw (ParserException ("Invalid URI: " ++ uri))) ] -- |Make a UNode from a rdf:ID element, expanding relative URIs diff --git a/testsuite/tests/Data/RDF/PropertyTests.hs b/testsuite/tests/Data/RDF/PropertyTests.hs index f4417d9..a5a0fee 100644 --- a/testsuite/tests/Data/RDF/PropertyTests.hs +++ b/testsuite/tests/Data/RDF/PropertyTests.hs @@ -131,7 +131,7 @@ arbitraryPrefixMappings = p_empty :: Rdf rdf => RDF rdf -> Bool -p_empty empty = triplesOf empty == [] +p_empty empty = null (triplesOf empty) -- triplesOf any RDF should return unique triples used to create it p_mkRdf_triplesOf @@ -445,7 +445,7 @@ p_remove_triple_from_singleton_graph_query_s :: (Rdf rdf) => RDF rdf -> SingletonGraph rdf -> Bool p_remove_triple_from_singleton_graph_query_s _unused singletonGraph = - query newGr (Just s) Nothing Nothing == [] + null (query newGr (Just s) Nothing Nothing) where tripleInGraph@(Triple s _p _o) = head (triplesOf (rdfGraph singletonGraph)) newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph @@ -457,7 +457,7 @@ p_remove_triple_from_singleton_graph_query_p :: (Rdf rdf) => RDF rdf -> SingletonGraph rdf -> Bool p_remove_triple_from_singleton_graph_query_p _unused singletonGraph = - query newGr Nothing (Just p) Nothing == [] + null (query newGr Nothing (Just p) Nothing) where tripleInGraph@(Triple _s p _o) = head (triplesOf (rdfGraph singletonGraph)) newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph @@ -469,7 +469,7 @@ p_remove_triple_from_singleton_graph_query_o :: (Rdf rdf) => RDF rdf -> SingletonGraph rdf -> Bool p_remove_triple_from_singleton_graph_query_o _unused singletonGraph = - query newGr Nothing Nothing (Just o) == [] + null (query newGr Nothing Nothing (Just o)) where tripleInGraph@(Triple _s _p o) = head (triplesOf (rdfGraph singletonGraph)) newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph @@ -482,10 +482,10 @@ p_add_then_remove_triples p_add_then_remove_triples _empty genTriples = let emptyGraph = _empty populatedGraph = - foldr (\t gr -> addTriple gr t) emptyGraph genTriples + foldr (flip addTriple) emptyGraph genTriples emptiedGraph = - foldr (\t gr -> removeTriple gr t) populatedGraph genTriples - in triplesOf emptiedGraph == [] + foldr (flip removeTriple) populatedGraph genTriples + in null (triplesOf emptiedGraph) equivNode :: (Node -> Node -> Bool) -> (Triple -> Node) @@ -601,8 +601,7 @@ instance Arbitrary Triple where arbitrary = do s <- arbitraryS p <- arbitraryP - o <- arbitraryO - return (triple s p o) + triple s p <$> arbitraryO instance Arbitrary Node where arbitrary = oneof $ map return unodes diff --git a/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs index 8d8f979..e29554d 100644 --- a/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs +++ b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs @@ -9,7 +9,6 @@ module Text.RDF.RDF4H.XmlParser_Test -- Testing imports import Test.Tasty -import Test.Tasty.HUnit import Test.Tasty.HUnit as TU -- Import common libraries to facilitate tests @@ -70,8 +69,8 @@ loadExpectedGraph1 fname = do loadInputGraph1 :: String -> String -> IO (Either ParseFailure (RDF TList)) loadInputGraph1 dir fname = - TIO.readFile (printf "%s/%s.rdf" dir fname :: String) >>= - return . parseString (XmlParser Nothing (mkDocUrl1 testBaseUri fname)) >>= return . handleLoad + (parseString (XmlParser Nothing (mkDocUrl1 testBaseUri fname)) <$> + TIO.readFile (printf "%s/%s.rdf" dir fname :: String)) doGoodConformanceTest :: IO (Either ParseFailure (RDF TList)) -> IO (Either ParseFailure (RDF TList)) -> diff --git a/testsuite/tests/W3C/Manifest.hs b/testsuite/tests/W3C/Manifest.hs index 736db43..ec9196e 100644 --- a/testsuite/tests/W3C/Manifest.hs +++ b/testsuite/tests/W3C/Manifest.hs @@ -125,8 +125,8 @@ mfUnrecognizedDatatypes = unode "http://www.w3.org/2001/sw/DataAccess/tests/test -- | Load the manifest from the given file; -- apply the given namespace as the base IRI of the manifest. loadManifest :: T.Text -> T.Text -> IO Manifest -loadManifest manifestPath baseIRI = do - parseFile testParser (T.unpack manifestPath) >>= return . rdfToManifest . fromEither +loadManifest manifestPath baseIRI = + (rdfToManifest . fromEither) <$> parseFile testParser (T.unpack manifestPath) where testParser = TurtleParser (Just $ BaseUrl baseIRI) Nothing rdfToManifest :: RDF TList -> Manifest diff --git a/testsuite/tests/W3C/RdfXmlTest.hs b/testsuite/tests/W3C/RdfXmlTest.hs index 6da83dd..0c20cf5 100644 --- a/testsuite/tests/W3C/RdfXmlTest.hs +++ b/testsuite/tests/W3C/RdfXmlTest.hs @@ -30,8 +30,8 @@ mfEntryToTest :: TestEntry -> TestTree mfEntryToTest (TestXMLEval nm _ _ act' res') = let act = (UNode . fromJust . fileSchemeToFilePath) act' res = (UNode . fromJust . fileSchemeToFilePath) res' - parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO (RDF TList) - expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO (RDF TList) + parsedRDF = (fromEither <$> parseFile testParser (nodeURI act)) :: IO (RDF TList) + expectedRDF = (fromEither <$> parseFile NTriplesParser (nodeURI res)) :: IO (RDF TList) in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF mfEntryToTest (TestXMLNegativeSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' diff --git a/testsuite/tests/W3C/TurtleTest.hs b/testsuite/tests/W3C/TurtleTest.hs index 8e30ede..4122ff8 100644 --- a/testsuite/tests/W3C/TurtleTest.hs +++ b/testsuite/tests/W3C/TurtleTest.hs @@ -31,8 +31,8 @@ mfEntryToTest :: TurtleParserCustom -> TestEntry -> TestTree mfEntryToTest parser (TestTurtleEval nm _ _ act' res') = let act = (UNode . fromJust . fileSchemeToFilePath) act' res = (UNode . fromJust . fileSchemeToFilePath) res' - parsedRDF = parseFile parser (nodeURI act) >>= return . fromEither :: IO (RDF TList) - expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO (RDF TList) + parsedRDF = (fromEither <$> parseFile parser (nodeURI act)) :: IO (RDF TList) + expectedRDF = (fromEither <$> parseFile NTriplesParser (nodeURI res)) :: IO (RDF TList) in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF mfEntryToTest parser (TestTurtleNegativeEval nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' From 287b0179e79a59798e60e6cd883d2bf625c7bda3 Mon Sep 17 00:00:00 2001 From: John Pavel Date: Wed, 23 Jan 2019 21:16:51 +0000 Subject: [PATCH 2/2] replace some data with newtype --- src/Text/RDF/RDF4H/NTriplesParser.hs | 2 +- src/Text/RDF/RDF4H/XmlParser.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Text/RDF/RDF4H/NTriplesParser.hs b/src/Text/RDF/RDF4H/NTriplesParser.hs index b7ad3ec..df060c1 100644 --- a/src/Text/RDF/RDF4H/NTriplesParser.hs +++ b/src/Text/RDF/RDF4H/NTriplesParser.hs @@ -39,7 +39,7 @@ import System.IO (IOMode(..), withFile, hSetNewlineMode, noNewlineTranslation, h -- class. data NTriplesParser = NTriplesParser -data NTriplesParserCustom = NTriplesParserCustom Parser +newtype NTriplesParserCustom = NTriplesParserCustom Parser -- |'NTriplesParser' is an instance of 'RdfParser' using parsec based parsers. instance RdfParser NTriplesParser where diff --git a/src/Text/RDF/RDF4H/XmlParser.hs b/src/Text/RDF/RDF4H/XmlParser.hs index b5e5761..eb834e3 100644 --- a/src/Text/RDF/RDF4H/XmlParser.hs +++ b/src/Text/RDF/RDF4H/XmlParser.hs @@ -80,7 +80,7 @@ instance RdfParser XmlParser where -- |Global state for the parser -data GParseState = GParseState { stateGenId :: Int +newtype GParseState = GParseState { stateGenId :: Int } deriving(Show) @@ -91,7 +91,7 @@ data LParseState = LParseState { stateBaseUrl :: BaseUrl } deriving(Show) -data ParserException = ParserException String +newtype ParserException = ParserException String deriving (Show,Typeable) instance Exception ParserException