diff --git a/rdf4h.cabal b/rdf4h.cabal --- a/rdf4h.cabal +++ b/rdf4h.cabal @@ -1,5 +1,5 @@ name: rdf4h -version: 1.2.7 +version: 1.3.0 synopsis: A library for RDF processing in Haskell description: 'RDF for Haskell' is a library for working with RDF in Haskell. @@ -8,8 +8,8 @@ for triples containing a particular subject, predicate, or object, or selecting triples that satisfy an arbitrary predicate function. -author: Calvin Smith -copyright: (c) Calvin Smith, Rob Stewart +author: Calvin Smith, Rob Stewart, Slava Kravchenko +copyright: (c) Calvin Smith, Rob Stewart, Slava Kravchenko maintainer: Rob Stewart homepage: https://github.com/robstewart57/rdf4h bug-reports: https://github.com/robstewart57/rdf4h/issues @@ -35,6 +35,10 @@ description: Use HPC for tests default: True +flag network-uri + description: Get Network.URI from the network-uri package + default: True + library exposed-modules: Data.RDF , Data.RDF.Namespace @@ -57,7 +61,15 @@ , text , unordered-containers , hashable - , network-uri + + if impl(ghc < 7.6) + build-depends: ghc-prim + + if flag(network-uri) + build-depends: network-uri >= 2.6, network >= 2.6 + else + build-depends: network-uri < 2.6, network < 2.6 + other-modules: Text.RDF.RDF4H.ParserUtils , Text.RDF.RDF4H.Interact hs-source-dirs: src @@ -76,7 +88,15 @@ , containers , text , hashable - , network-uri + + if impl(ghc < 7.6) + build-depends: ghc-prim + + if flag(network-uri) + build-depends: network-uri >= 2.6, network >= 2.6 + else + build-depends: network-uri < 2.6, network < 2.6 + hs-source-dirs: src extensions: BangPatterns RankNTypes ScopedTypeVariables MultiParamTypeClasses OverloadedStrings ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields @@ -101,7 +121,15 @@ , knob , unordered-containers , hashable - , network-uri + + if impl(ghc < 7.6) + build-depends: ghc-prim + + if flag(network-uri) + build-depends: network-uri >= 2.6, network >= 2.6 + else + build-depends: network-uri < 2.6, network < 2.6 + other-modules: Data.RDF , Data.RDF.Namespace , Data.RDF.MGraph diff --git a/src/Data/RDF/MGraph.hs b/src/Data/RDF/MGraph.hs --- a/src/Data/RDF/MGraph.hs +++ b/src/Data/RDF/MGraph.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TupleSections #-} -- |A simple graph implementation backed by 'Data.HashMap'. -module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, select, query) +module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, uniqTriplesOf, select, query) where @@ -40,6 +40,7 @@ empty = empty' mkRdf = mkRdf' triplesOf = triplesOf' + uniqTriplesOf = uniqTriplesOf' select = select' query = query' @@ -105,6 +106,10 @@ triplesOf' :: MGraph -> Triples triplesOf' (MGraph ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps where subjPredMaps = HashMap.toList spoMap + +-- naive implementation for now +uniqTriplesOf' :: MGraph -> Triples +uniqTriplesOf' = nub . expandTriples tripsSubj :: Subject -> AdjacencyMap -> Triples tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (HashMap.toList adjMap) diff --git a/src/Data/RDF/Namespace.hs b/src/Data/RDF/Namespace.hs --- a/src/Data/RDF/Namespace.hs +++ b/src/Data/RDF/Namespace.hs @@ -12,8 +12,7 @@ -- * Predefined namespace values rdf, rdfs, dc, dct, owl, xsd, skos, foaf, ex, ex2, standard_ns_mappings, ns_mappings -) -where +) where import qualified Data.Text as T import Data.RDF.Types diff --git a/src/Data/RDF/Query.hs b/src/Data/RDF/Query.hs --- a/src/Data/RDF/Query.hs +++ b/src/Data/RDF/Query.hs @@ -1,24 +1,25 @@ - module Data.RDF.Query ( -- * Query functions - sortTriples, equalSubjects, equalPredicates, equalObjects, + equalSubjects, equalPredicates, equalObjects, subjectOf, predicateOf, objectOf, isEmpty, - rdfContainsNode, tripleContainsNode, removeDupes, + rdfContainsNode, tripleContainsNode, listSubjectsWithPredicate, listObjectsOfPredicate, -- * RDF graph functions - isIsomorphic, expandTriples, fromEither + isIsomorphic, expandTriples, fromEither, + -- * Miscellaneous functions + expandTriple, expandNode, expandURI + ) where import Prelude hiding (pred) import Data.List import Data.RDF.Types - --- |Answer the given list of triples in sorted order. -sortTriples :: Triples -> Triples -sortTriples = sort +import qualified Data.RDF.Namespace as NS (toPMList, uriOf, rdf) +import qualified Data.Text as T +import Data.Maybe (catMaybes) -- |Answer the subject node of the triple. {-# INLINE subjectOf #-} @@ -43,21 +44,24 @@ in elem True xs -- |Answer if triple contains node. +-- Note that it doesn't perform namespace expansion! tripleContainsNode :: Node -> Triple -> Bool {-# INLINE tripleContainsNode #-} tripleContainsNode node t = subjectOf t == node || predicateOf t == node || objectOf t == node - -- |Determine whether two triples have equal subjects. +-- Note that it doesn't perform namespace expansion! equalSubjects :: Triple -> Triple -> Bool equalSubjects (Triple s1 _ _) (Triple s2 _ _) = s1 == s2 -- |Determine whether two triples have equal predicates. +-- Note that it doesn't perform namespace expansion! equalPredicates :: Triple -> Triple -> Bool equalPredicates (Triple _ p1 _) (Triple _ p2 _) = p1 == p2 -- |Determine whether two triples have equal objects. +-- Note that it doesn't perform namespace expansion! equalObjects :: Triple -> Triple -> Bool equalObjects (Triple _ _ o1) (Triple _ _ o2) = o1 == o2 @@ -91,12 +95,6 @@ (Left err) -> error (show err) (Right rdf) -> rdf --- |Remove duplicate triples, returning unique triples. This --- function may return the triples in a different order than --- given. -removeDupes :: Triples -> Triples -removeDupes = map head . group . sort - -- |This determines if two RDF representations are equal regardless of blank -- node names, triple order and prefixes. In math terms, this is the \simeq -- latex operator, or ~= @@ -113,7 +111,34 @@ expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples expandTriples' acc _ _ [] = acc expandTriples' acc baseURL prefixMaps (t:rest) = expandTriples' (normalize baseURL prefixMaps t : acc) baseURL prefixMaps rest - where normalize baseURL' prefixMaps' = expandPrefixes prefixMaps' . expandBaseUrl baseURL' - expandBaseUrl (Just _) triple' = triple' - expandBaseUrl Nothing triple' = triple' - expandPrefixes _ triple' = triple' + where normalize baseURL' prefixMaps' = absolutizeTriple baseURL' . expandTriple prefixMaps' + +-- |Expand the triple with the prefix map. +expandTriple :: PrefixMappings -> Triple -> Triple +expandTriple pms t = triple (expandNode pms $ subjectOf t) (expandNode pms $ predicateOf t) (expandNode pms $ objectOf t) + +-- |Expand the node with the prefix map. +-- Only UNodes are expanded, other kinds of nodes are returned as-is. +expandNode :: PrefixMappings -> Node -> Node +expandNode pms (UNode n) = unode $ expandURI pms n +expandNode _ n' = n' + +-- |Expand the URI with the prefix map. +-- Also expands "a" to "http://www.w3.org/1999/02/22-rdf-syntax-ns#type". +expandURI :: PrefixMappings -> T.Text -> T.Text +expandURI _ "a" = T.append (NS.uriOf NS.rdf) "type" +expandURI pms' x = firstExpandedOrOriginal x $ catMaybes $ map (resourceTail x) (NS.toPMList pms') + where resourceTail :: T.Text -> (T.Text, T.Text) -> Maybe T.Text + resourceTail x' (p', u') = T.stripPrefix (T.append p' ":") x' >>= Just . T.append u' + firstExpandedOrOriginal :: a -> [a] -> a + firstExpandedOrOriginal orig' [] = orig' + firstExpandedOrOriginal _ (e:_) = e + +-- |Prefixes relative URIs in the triple with BaseUrl. +absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple +absolutizeTriple base t = triple (absolutizeNode base $ subjectOf t) (absolutizeNode base $ predicateOf t) (absolutizeNode base $ objectOf t) + +-- |Prepends BaseUrl to UNodes with relative URIs. +absolutizeNode :: Maybe BaseUrl -> Node -> Node +absolutizeNode (Just (BaseUrl b')) (UNode u') = unode $ mkAbsoluteUrl b' u' +absolutizeNode _ n = n diff --git a/src/Data/RDF/TriplesGraph.hs b/src/Data/RDF/TriplesGraph.hs --- a/src/Data/RDF/TriplesGraph.hs +++ b/src/Data/RDF/TriplesGraph.hs @@ -8,7 +8,7 @@ -- functions of this graph (select, query) remove duplicates from their -- result triples (but triplesOf does not) since it is usually cheap -- to do so. -module Data.RDF.TriplesGraph(TriplesGraph, empty, mkRdf, triplesOf, select, query) +module Data.RDF.TriplesGraph(TriplesGraph, empty, mkRdf, triplesOf, uniqTriplesOf, select, query) where @@ -17,6 +17,7 @@ import Data.RDF.Namespace import Data.RDF.Query import Data.RDF.Types +import Data.List (nub) -- |A simple implementation of the 'RDF' type class that represents -- the graph internally as a list of triples. @@ -46,6 +47,7 @@ empty = empty' mkRdf = mkRdf' triplesOf = triplesOf' + uniqTriplesOf = uniqTriplesOf' select = select' query = query' @@ -76,11 +78,14 @@ triplesOf' :: TriplesGraph -> Triples triplesOf' (TriplesGraph (ts, _, _)) = ts +uniqTriplesOf' :: TriplesGraph -> Triples +uniqTriplesOf' = nub . expandTriples + select' :: TriplesGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples -select' (TriplesGraph (ts, _, _)) s p o = removeDupes $ filter (matchSelect s p o) ts +select' g s p o = filter (matchSelect s p o) $ triplesOf g query' :: TriplesGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples -query' (TriplesGraph (ts, _, _)) s p o = removeDupes $ filter (matchPattern s p o) ts +query' g s p o = filter (matchPattern s p o) $ triplesOf g matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool matchSelect s p o t = diff --git a/src/Data/RDF/Types.hs b/src/Data/RDF/Types.hs --- a/src/Data/RDF/Types.hs +++ b/src/Data/RDF/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Data.RDF.Types ( @@ -14,8 +14,11 @@ -- * Node query function isUNode,isLNode,isBNode, + -- * Miscellaneous + resolveQName, absolutizeUrl, isAbsoluteUri, mkAbsoluteUrl, + -- * RDF Type - RDF(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,select,query), + RDF(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,uniqTriplesOf,select,query), -- * Parsing RDF RdfParser(parseString,parseFile,parseURL), @@ -41,6 +44,7 @@ import Data.Hashable(Hashable) import qualified Data.List as List import qualified Data.Map as Map +import qualified Network.URI as Network (isURI) ------------------- -- LValue and constructor functions @@ -86,7 +90,7 @@ -- node ('BNode'), or a literal node ('LNode'). data Node = - -- |An RDF URI reference. See + -- |An RDF URI reference. URIs conform to the RFC3986 standard. See -- for more -- information. UNode !T.Text @@ -172,6 +176,10 @@ isLNode (LNode _) = True isLNode _ = False +{-# INLINE isAbsoluteUri #-} +isAbsoluteUri :: T.Text -> Bool +isAbsoluteUri = Network.isURI . T.unpack + -- |A type class for ADTs that expose views to clients. class View a b where view :: a -> b @@ -206,8 +214,16 @@ mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> rdf -- |Return all triples in the RDF, as a list. + -- + -- Note that this function returns a list of triples in the RDF as they + -- were added, without removing duplicates and without expanding namespaces. triplesOf :: rdf -> Triples + -- |Return unique triples in the RDF, as a list. + -- + -- This function performs namespace expansion and removal of duplicates. + uniqTriplesOf :: rdf -> Triples + -- |Select the triples in the RDF that match the given selectors. -- -- The three NodeSelector parameters are optional functions that match @@ -479,6 +495,42 @@ deriving (Eq, Ord) instance Show PrefixMapping where show (PrefixMapping (prefix, uri)) = printf "PrefixMapping (%s, %s)" (show prefix) (show uri) + +----------------- +-- Miscellaneous helper functions used throughout the project + +-- Resolve a prefix using the given prefix mappings and base URL. If the prefix is +-- empty, then the base URL will be used if there is a base URL and if the map +-- does not contain an entry for the empty prefix. +resolveQName :: Maybe BaseUrl -> T.Text -> PrefixMappings -> Maybe T.Text +resolveQName mbaseUrl prefix (PrefixMappings pms') = + case (mbaseUrl, T.null prefix) of + (Just (BaseUrl base), True) -> Just $ Map.findWithDefault base T.empty pms' + (Nothing, True) -> Nothing + (_, _ ) -> Map.lookup prefix pms' + +-- Resolve a URL fragment found on the right side of a prefix mapping +-- by converting it to an absolute URL if possible. +absolutizeUrl :: Maybe BaseUrl -> Maybe T.Text -> T.Text -> T.Text +absolutizeUrl mbUrl mdUrl urlFrag = + if isAbsoluteUri urlFrag then urlFrag else + (case (mbUrl, mdUrl) of + (Nothing, Nothing) -> urlFrag + (Just (BaseUrl bUrl), Nothing) -> bUrl `T.append` urlFrag + (Nothing, Just dUrl) -> if isHash urlFrag then + dUrl `T.append` urlFrag else urlFrag + (Just (BaseUrl bUrl), Just dUrl) -> (if isHash urlFrag then dUrl + else bUrl) + `T.append` urlFrag) + where + isHash bs' = bs' == "#" + +{-# INLINE mkAbsoluteUrl #-} +-- Make an absolute URL by returning as is if already an absolute URL and otherwise +-- appending the URL to the given base URL. +mkAbsoluteUrl :: T.Text -> T.Text -> T.Text +mkAbsoluteUrl base url = + if isAbsoluteUri url then url else base `T.append` url ----------------- diff --git a/src/Text/RDF/RDF4H/ParserUtils.hs b/src/Text/RDF/RDF4H/ParserUtils.hs --- a/src/Text/RDF/RDF4H/ParserUtils.hs +++ b/src/Text/RDF/RDF4H/ParserUtils.hs @@ -6,7 +6,7 @@ import Network.URI import Network.HTTP -import Data.Char(intToDigit) +import Data.Char (intToDigit) import Data.Text.Encoding (decodeUtf8) import qualified Data.ByteString.Char8 as B import qualified Data.Text as T @@ -23,8 +23,8 @@ justTriples = map (fromMaybe (error "ParserUtils.justTriples")) . filter (/= Nothing) --- | pars contents at URL in to and 'RDF' -_parseURL :: RDF rdf => (T.Text -> Either ParseFailure rdf) -> String -> IO (Either ParseFailure rdf) +-- | Parse contents at URL into an 'RDF'. +_parseURL :: RDF rdf => (T.Text -> Either ParseFailure rdf) -> String -> IO (Either ParseFailure rdf) _parseURL parseFunc url = maybe (return (Left (ParseFailure $ "Unable to parse URL: " ++ url))) @@ -41,7 +41,7 @@ (2, 0, 0) -> return $ parseFunc (decodeUtf8 (rspBody res)) _ -> return (errResult $ "couldn't retrieve from URL: " ++ httpError res) --- | construct HTTP GET request. +-- | Construct HTTP GET request. request :: URI -> HTTPRequest B.ByteString request uri = Request { rqURI = uri, rqMethod = GET, diff --git a/src/Text/RDF/RDF4H/TurtleParser.hs b/src/Text/RDF/RDF4H/TurtleParser.hs --- a/src/Text/RDF/RDF4H/TurtleParser.hs +++ b/src/Text/RDF/RDF4H/TurtleParser.hs @@ -107,7 +107,9 @@ char ':' name <- option T.empty t_name (bUrl, _, _, pms, _, _, _, _) <- getState - return $ resolveQName bUrl pre pms `T.append` name + case resolveQName bUrl pre pms of + Just n -> return $ n `T.append` name + Nothing -> error ("Cannot resolve QName prefix: " ++ T.unpack pre) t_subject :: GenParser ParseState () t_subject = @@ -398,48 +400,9 @@ in_range :: Char -> [(Char, Char)] -> Bool in_range c = any (\(c1, c2) -> c >= c1 && c <= c2) --- Resolve a prefix using the given prefix mappings and base URL. If the prefix is --- empty, then the base URL will be used if there is a base URL and if the map --- does not contain an entry for the empty prefix. -resolveQName :: Maybe BaseUrl -> T.Text -> PrefixMappings -> T.Text -resolveQName mbaseUrl prefix (PrefixMappings pms') = - case (mbaseUrl, T.null prefix) of - (Just (BaseUrl base), True) -> Map.findWithDefault base T.empty pms' - (Nothing, True) -> err1 - (_, _ ) -> Map.findWithDefault err2 prefix pms' - where - err1 = error "Cannot resolve empty QName prefix to a Base URL." - err2 = error ("Cannot resolve QName prefix: " ++ T.unpack prefix) - --- Resolve a URL fragment found on the right side of a prefix mapping by converting it to an absolute URL if possible. -absolutizeUrl :: Maybe BaseUrl -> Maybe T.Text -> T.Text -> T.Text -absolutizeUrl mbUrl mdUrl urlFrag = - if isAbsoluteUri urlFrag then urlFrag else - (case (mbUrl, mdUrl) of - (Nothing, Nothing) -> urlFrag - (Just (BaseUrl bUrl), Nothing) -> bUrl `T.append` urlFrag - (Nothing, Just dUrl) -> if isHash urlFrag then - dUrl `T.append` urlFrag else urlFrag - (Just (BaseUrl bUrl), Just dUrl) -> (if isHash urlFrag then dUrl - else bUrl) - `T.append` urlFrag) - where - isHash bs' = T.length bs' == 1 && T.head bs' == '#' - -{-# INLINE isAbsoluteUri #-} -isAbsoluteUri :: T.Text -> Bool -isAbsoluteUri = T.isInfixOf (T.pack [':']) - newBaseUrl :: Maybe BaseUrl -> T.Text -> BaseUrl -newBaseUrl Nothing url = BaseUrl url +newBaseUrl Nothing url = BaseUrl url newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url - -{-# INLINE mkAbsoluteUrl #-} --- Make an absolute URL by returning as is if already an absolute URL and otherwise --- appending the URL to the given base URL. -mkAbsoluteUrl :: T.Text -> T.Text -> T.Text -mkAbsoluteUrl base url = - if isAbsoluteUri url then url else base `T.append` url currBaseUrl :: GenParser ParseState (Maybe BaseUrl) currBaseUrl = getState >>= \(bUrl, _, _, _, _, _, _, _) -> return bUrl diff --git a/testsuite/tests/Test.hs b/testsuite/tests/Test.hs --- a/testsuite/tests/Test.hs +++ b/testsuite/tests/Test.hs @@ -6,11 +6,11 @@ import qualified Data.RDF.MGraph_Test as MGraph import qualified Text.RDF.RDF4H.XmlParser_Test as XmlParser import qualified Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleParser +import Data.RDF.GraphTestUtils -main :: IO () -main = defaultMain ( TriplesGraph.tests - ++ MGraph.tests +main :: IO () +main = defaultMain ( graphTests "TriplesGraph" TriplesGraph.triplesOf' TriplesGraph.uniqTriplesOf' TriplesGraph.empty' TriplesGraph.mkRdf' + ++ graphTests "MGraph" MGraph.triplesOf' MGraph.uniqTriplesOf' MGraph.empty' MGraph.mkRdf' ++ TurtleParser.tests ++ XmlParser.tests ) -