{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : GraphClass -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, -- 2011, 2012, 2016 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiParamTypeClasses -- -- This module defines a Labelled Directed Graph and Label classes, -- and the Arc datatype. -- -------------------------------------------------------------------------------- ------------------------------------------------------------ -- Define LDGraph, arc and related classes and types ------------------------------------------------------------ module Swish.GraphClass ( LDGraph(..) , Label(..) , Arc(..) , ArcSet , Selector , arc, arcToTriple, arcFromTriple , hasLabel, arcLabels -- , arcNodes , getComponents ) where import Data.Hashable (Hashable(..)) import Data.List (foldl') import Data.Ord (comparing) import qualified Data.Foldable as F import qualified Data.Set as S import qualified Data.Traversable as T -- NOTE: I wanted to declare this as a subclass of Functor, but -- the constraint on the label type seems to prevent that. -- So I've just declared specific instances to be Functors. -- {-| Labelled Directed Graph class. Minimum required implementation: 'emptyGraph', 'setArcs', and 'getArcs'. -} class LDGraph lg lb where -- | Create the empty graph. emptyGraph :: lg lb -- | Replace the existing arcs in the graph. setArcs :: lg lb -> ArcSet lb -> lg lb -- | Extract all the arcs from a graph getArcs :: lg lb -> ArcSet lb -- | Extract those arcs that match the given `Selector`. extract :: (Ord lb) => Selector lb -> lg lb -> lg lb extract sel = update (S.filter sel) -- | Add the two graphs addGraphs :: (Ord lb) => lg lb -> lg lb -> lg lb addGraphs addg = update (S.union (getArcs addg)) -- | Remove those arcs in the first graph from the second -- graph delete :: (Ord lb) => lg lb -- ^ g1 -> lg lb -- ^ g2 -> lg lb -- ^ g2 - g1 -> g3 delete g1 g2 = setArcs g2 (getArcs g2 `S.difference` getArcs g1) -- | Enumerate the distinct labels contained in a graph; -- that is, any label that appears in the subject, -- predicate or object position of an `Arc`. labels :: (Ord lb) => lg lb -> S.Set lb labels = getComponents arcLabels . getArcs -- | Enumerate the distinct nodes contained in a graph; -- that is, any label that appears in the subject -- or object position of an `Arc`. nodes :: (Ord lb) => lg lb -> S.Set lb nodes = getComponents arcNodes . getArcs -- | Update the arcs in a graph using a supplied function. update :: (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb update f g = setArcs g ( f (getArcs g) ) -- | Extract components from a set. getComponents :: Ord b => (a -> [b]) -> S.Set a -> S.Set b getComponents f = let ins sgr = foldl' (flip S.insert) sgr . f in S.foldl' ins S.empty -- | Label class. -- -- A label may have a fixed binding, which means that the label identifies (is) a -- particular graph node, and different such labels are always distinct nodes. -- Alternatively, a label may be unbound (variable), which means that it is a -- placeholder for an unknown node label. Unbound node labels are used as -- graph-local identifiers for indicating when the same node appears in -- several arcs. -- -- For the purposes of graph-isomorphism testing, fixed labels are matched when they -- are the same. Variable labels may be matched with any other variable label. -- Our definition of isomorphism (for RDF graphs) does not match variable labels -- with fixed labels. -- -- We do not need Ord/Show constraints here, but it means we can just use -- Label as a short-form for Ord/Show in code class (Ord lb, Show lb) => Label lb where -- | Does this node have a variable binding? labelIsVar :: lb -> Bool -- | Calculate the hash of the label using the supplied seed. labelHash :: Int -> lb -> Int -- could provide a default of -- labelHash = hashWithSalt -- but this would then force a Hashable constraint -- | Extract the local id from a variable node. getLocal :: lb -> String -- | Make a label value from a local id. makeLabel :: String -> lb -- | Arc type. -- -- Prior to @0.7.0.0@ you could also use @asubj@, @apred@ and @aobj@ -- to access the elements of the arc. -- data Arc lb = Arc { arcSubj :: lb -- ^ The subject of the arc. , arcPred :: lb -- ^ The predicate (property) of the arc. , arcObj :: lb -- ^ The object of the arc. } deriving (Eq, Functor, F.Foldable, T.Traversable) -- | A set - or graph - of arcs. type ArcSet lb = S.Set (Arc lb) instance (Hashable lb) => Hashable (Arc lb) where #if MIN_VERSION_hashable(1,2,0) #else hash (Arc s p o) = hash s `hashWithSalt` p `hashWithSalt` o #endif hashWithSalt salt (Arc s p o) = salt `hashWithSalt` s `hashWithSalt` p `hashWithSalt` o -- | Create an arc. arc :: lb -- ^ The subject of the arc. -> lb -- ^ The predicate of the arc. -> lb -- ^ The object of the arc. -> Arc lb arc = Arc -- | Convert an Arc into a tuple. arcToTriple :: Arc lb -> (lb,lb,lb) arcToTriple (Arc s p o) = (s, p, o) -- | Create an Arc from a tuple. arcFromTriple :: (lb,lb,lb) -> Arc lb arcFromTriple (s,p,o) = Arc s p o instance Ord lb => Ord (Arc lb) where compare = comparing arcToTriple instance (Show lb) => Show (Arc lb) where show (Arc lb1 lb2 lb3) = "("++ show lb1 ++","++ show lb2 ++","++ show lb3 ++")" -- | Identify arcs. type Selector lb = Arc lb -> Bool -- | Does the arc contain the label in any position (subject, predicate, or object)? hasLabel :: (Eq lb) => lb -> Arc lb -> Bool hasLabel lbv lb = lbv `elem` arcLabels lb -- | Return all the labels in an arc. arcLabels :: Arc lb -> [lb] arcLabels (Arc lb1 lb2 lb3) = [lb1,lb2,lb3] -- | Return just the subject and object labels in the arc. arcNodes :: Arc lb -> [lb] arcNodes (Arc lb1 _ lb3) = [lb1,lb3] -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, -- 2011, 2012 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. -- -- Swish is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- Swish is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Swish; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- --------------------------------------------------------------------------------