rdf4h 1.2.3 → 1.2.4
raw patch · 3 files changed
+76/−56 lines, 3 filesdep +hashabledep +unordered-containers
Dependencies added: hashable, unordered-containers
Files
- rdf4h.cabal +7/−2
- src/Data/RDF/MGraph.hs +60/−54
- src/Data/RDF/Types.hs +9/−0
rdf4h.cabal view
@@ -1,5 +1,5 @@ name: rdf4h-version: 1.2.3+version: 1.2.4 synopsis: A library for RDF processing in Haskell description: 'RDF for Haskell' is a library for working with RDF in Haskell.@@ -56,11 +56,13 @@ , HTTP >= 4000.0.0 , hxt >= 9.3.1.2 , text+ , unordered-containers+ , hashable other-modules: Text.RDF.RDF4H.ParserUtils , Text.RDF.RDF4H.Interact hs-source-dirs: src extensions: BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings- ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields+ ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -O2 executable rdf4h main-is: Rdf4hParseMain.hs @@ -74,6 +76,7 @@ , hxt >= 9.3.1.2 , containers , text+ , hashable hs-source-dirs: src extensions: BangPatterns RankNTypes ScopedTypeVariables MultiParamTypeClasses OverloadedStrings ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields@@ -97,6 +100,8 @@ , containers , text , knob+ , unordered-containers+ , hashable other-modules: Data.RDF , Data.RDF.Namespace , Data.RDF.MGraph
src/Data/RDF/MGraph.hs view
@@ -1,4 +1,5 @@--- |A simple graph implementation backed by 'Data.Map'.+{-# LANGUAGE TupleSections #-}+-- |A simple graph implementation backed by 'Data.HashMap'. module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, select, query) @@ -8,10 +9,12 @@ import Data.RDF.Types import Data.RDF.Query import Data.RDF.Namespace-import Data.Map(Map) import qualified Data.Map as Map-import Data.Set(Set)-import qualified Data.Set as Set+import Data.Hashable()+import Data.HashMap.Strict(HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.HashSet(HashSet)+import qualified Data.HashSet as Set import Data.List -- |A map-based graph implementation.@@ -28,7 +31,7 @@ -- * 'select' : O(n) -- -- * 'query' : O(log n)-newtype MGraph = MGraph (SPOMap, Maybe BaseUrl, PrefixMappings)+newtype MGraph = MGraph (TMaps, Maybe BaseUrl, PrefixMappings) instance RDF MGraph where baseUrl = baseUrl'@@ -44,12 +47,14 @@ -- An adjacency map for a subject, mapping from a predicate node to -- to the adjacent nodes via that predicate.-type AdjacencyMap = Map Predicate Adjacencies+type AdjacencyMap = HashMap Predicate (HashSet Node) ----type Adjacencies = Set Object-type SPOMap = Map Subject AdjacencyMap+type Adjacencies = HashSet Node +type TMap = HashMap Node AdjacencyMap+type TMaps = (TMap, TMap)++ baseUrl' :: MGraph -> Maybe BaseUrl baseUrl' (MGraph (_, baseURL, _)) = baseURL @@ -62,94 +67,95 @@ in MGraph (ts, baseURL, merge pms pms') empty' :: MGraph-empty' = MGraph (Map.empty, Nothing, PrefixMappings Map.empty)+empty' = MGraph ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty) mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph-mkRdf' ts baseURL pms = MGraph (mergeTs Map.empty ts, baseURL, pms)+mkRdf' ts baseURL pms = MGraph (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms) -mergeTs :: SPOMap -> [Triple] -> SPOMap+mergeTs :: TMaps -> [Triple] -> TMaps mergeTs = foldl' mergeT where- mergeT :: SPOMap -> Triple -> SPOMap+ mergeT :: TMaps -> Triple -> TMaps mergeT m t = mergeT' m (subjectOf t) (predicateOf t) (objectOf t) -mergeT' :: SPOMap -> Subject -> Predicate -> Object -> SPOMap-mergeT' m s p o =- if s `Map.member` m then- (if p `Map.member` adjs then Map.insert s addPredObj m- else Map.insert s addNewPredObjMap m)- else Map.insert s newPredMap m+mergeT' :: TMaps -> Subject -> Predicate -> Object -> TMaps+mergeT' (spo, ops) s p o = (mergeT'' spo s p o, mergeT'' ops o p s)++mergeT'' :: TMap -> Subject -> Predicate -> Object -> TMap+mergeT'' m s p o =+ if s `HashMap.member` m then+ (if p `HashMap.member` adjs then HashMap.insert s addPredObj m+ else HashMap.insert s addNewPredObjMap m)+ else HashMap.insert s newPredMap m where- adjs = get s m- newPredMap :: Map Predicate (Set Object)- newPredMap = Map.singleton p (Set.singleton o)- addNewPredObjMap :: Map Predicate (Set Object)- addNewPredObjMap = Map.insert p (Set.singleton o) adjs- addPredObj :: Map Predicate (Set Object)- addPredObj = Map.insert p (Set.insert o (get p adjs)) adjs- get :: Ord k => k -> Map k v -> v- get = Map.findWithDefault undefined+ adjs = HashMap.lookupDefault HashMap.empty s m+ newPredMap :: HashMap Predicate (HashSet Object)+ newPredMap = HashMap.singleton p (Set.singleton o)+ addNewPredObjMap :: HashMap Predicate (HashSet Object)+ addNewPredObjMap = HashMap.insert p (Set.singleton o) adjs+ addPredObj :: HashMap Predicate (HashSet Object)+ addPredObj = HashMap.insert p (Set.insert o (get p adjs)) adjs+ --get :: (Ord k, Hashable k) => k -> HashMap k v -> v+ get = HashMap.lookupDefault Set.empty -- 3 following functions support triplesOf triplesOf' :: MGraph -> Triples-triplesOf' (MGraph (spoMap, _, _)) = concatMap (uncurry tripsSubj) subjPredMaps- where subjPredMaps = Map.toList spoMap+triplesOf' (MGraph ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps+ where subjPredMaps = HashMap.toList spoMap tripsSubj :: Subject -> AdjacencyMap -> Triples-tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (Map.toList adjMap)+tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (HashMap.toList adjMap) where tfsp = tripsForSubjPred tripsForSubjPred :: Subject -> Predicate -> Adjacencies -> Triples-tripsForSubjPred s p adjs = map (Triple s p) (Set.elems adjs)+tripsForSubjPred s p adjs = map (Triple s p) (Set.toList adjs) -- supports select select' :: MGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' (MGraph (spoMap,_,_)) subjFn predFn objFn =+select' (MGraph ((spoMap,_),_,_)) subjFn predFn objFn = map (\(s,p,o) -> Triple s p o) $ Set.toList $ sel1 subjFn predFn objFn spoMap -sel1 :: NodeSelector -> NodeSelector -> NodeSelector -> SPOMap -> Set (Node, Node, Node)+sel1 :: NodeSelector -> NodeSelector -> NodeSelector -> TMap -> HashSet (Node, Node, Node) sel1 (Just subjFn) p o spoMap =- Set.unions $ map (sel2 p o) $ filter (\(x,_) -> subjFn x) $ Map.toList spoMap-sel1 Nothing p o spoMap = Set.unions $ map (sel2 p o) $ Map.toList spoMap+ Set.unions $ map (sel2 p o) $ filter (\(x,_) -> subjFn x) $ HashMap.toList spoMap+sel1 Nothing p o spoMap = Set.unions $ map (sel2 p o) $ HashMap.toList spoMap -sel2 :: NodeSelector -> NodeSelector -> (Node, Map Node (Set Node)) -> Set (Node, Node, Node)+sel2 :: NodeSelector -> NodeSelector -> (Node, HashMap Node (HashSet Node)) -> HashSet (Node, Node, Node) sel2 (Just predFn) mobjFn (s, ps) = Set.map (\(p,o) -> (s,p,o)) $ foldl' Set.union Set.empty $- map (sel3 mobjFn) poMapS :: Set (Node, Node, Node)+ map (sel3 mobjFn) poMapS :: HashSet (Node, Node, Node) where- poMapS :: [(Node, Set Node)]- poMapS = filter (\(k,_) -> predFn k) $ Map.toList ps+ poMapS :: [(Node, HashSet Node)]+ poMapS = filter (\(k,_) -> predFn k) $ HashMap.toList ps sel2 Nothing mobjFn (s, ps) = Set.map (\(p,o) -> (s,p,o)) $ foldl' Set.union Set.empty $ map (sel3 mobjFn) poMaps where- poMaps = Map.toList ps+ poMaps = HashMap.toList ps -sel3 :: NodeSelector -> (Node, Set Node) -> Set (Node, Node)+sel3 :: NodeSelector -> (Node, HashSet Node) -> HashSet (Node, Node) sel3 (Just objFn) (p, os) = Set.map (\o -> (p, o)) $ Set.filter objFn os sel3 Nothing (p, os) = Set.map (\o -> (p, o)) os -- support query query' :: MGraph -> Maybe Node -> Maybe Predicate -> Maybe Node -> Triples-query' (MGraph (spoMap,_ , _)) subj pred obj = map f $ Set.toList $ q1 subj pred obj spoMap+query' (MGraph (m,_ , _)) subj pred obj = map f $ Set.toList $ q1 subj pred obj m where f (s, p, o) = Triple s p o -q1 :: Maybe Node -> Maybe Node -> Maybe Node -> SPOMap -> Set (Node, Node, Node)-q1 (Just s) p o spoMap = q2 p o (s, Map.findWithDefault Map.empty s spoMap)-q1 Nothing p o spoMap = Set.unions $ map (q2 p o) $ Map.toList spoMap+q1 :: Maybe Node -> Maybe Node -> Maybe Node -> TMaps -> HashSet (Node, Node, Node)+q1 (Just s) p o (spoMap, _ ) = q2 p o (s, HashMap.lookupDefault HashMap.empty s spoMap)+q1 s p (Just o) (_ , opsMap) = Set.map (\(o',p',s') -> (s',p',o')) $ q2 p s (o, HashMap.lookupDefault HashMap.empty o opsMap)+q1 Nothing p o (spoMap, _ ) = Set.unions $ map (q2 p o) $ HashMap.toList spoMap -q2 :: Maybe Node -> Maybe Node -> (Node, Map Node (Set Node)) -> Set (Node, Node, Node)+q2 :: Maybe Node -> Maybe Node -> (Node, HashMap Node (HashSet Node)) -> HashSet (Node, Node, Node) q2 (Just p) o (s, pmap) =- if p `Map.member` pmap then- Set.map (\ (p', o') -> (s, p', o')) $- q3 o (p, Map.findWithDefault undefined p pmap)- else Set.empty+ maybe Set.empty (Set.map (\ (p', o') -> (s, p', o')) . q3 o . (p,)) $ HashMap.lookup p pmap q2 Nothing o (s, pmap) = Set.map (\(x,y) -> (s,x,y)) $ Set.unions $ map (q3 o) opmaps- where opmaps ::[(Node, Set Node)]- opmaps = Map.toList pmap+ where opmaps ::[(Node, HashSet Node)]+ opmaps = HashMap.toList pmap -q3 :: Maybe Node -> (Node, Set Node) -> Set (Node, Node)+q3 :: Maybe Node -> (Node, HashSet Node) -> HashSet (Node, Node) q3 (Just o) (p, os) = if o `Set.member` os then Set.singleton (p, o) else Set.empty q3 Nothing (p, os) = Set.map (\o -> (p, o)) os
src/Data/RDF/Types.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} module Data.RDF.Types ( @@ -36,6 +37,8 @@ import System.IO import Text.Printf import Data.Map(Map)+import GHC.Generics (Generic)+import Data.Hashable(Hashable) import qualified Data.List as List import qualified Data.Map as Map @@ -57,6 +60,7 @@ -- |A typed literal value consisting of the literal value and -- the URI of the datatype of the value, respectively. | TypedL !T.Text !T.Text+ deriving Generic -- |Return a PlainL LValue for the given string value. {-# INLINE plainL #-}@@ -100,6 +104,7 @@ -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-Literal> for more -- information. | LNode !LValue+ deriving Generic -- |An alias for 'Node', defined for convenience and readability purposes. type Subject = Node@@ -369,6 +374,8 @@ compareNode (LNode (TypedL _ _)) (LNode _) = GT compareNode (LNode _) _ = GT +instance Hashable Node+ -- |Two triples are equal iff their respective subjects, predicates, and objects -- are equal. instance Eq Triple where@@ -419,6 +426,8 @@ EQ -> compare l1 l2 GT -> GT LT -> LT++instance Hashable LValue -- String representations of the various data types; generally NTriples-like.