{-# 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 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : 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(..) , Selector , arc, arcToTriple, arcFromTriple , hasLabel, arcLabels -- , arcNodes ) where import Data.Hashable (Hashable(..)) import Data.List (foldl', union, (\\)) import qualified Data.Foldable as F 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 (Eq (lg lb), Eq lb ) => LDGraph lg lb where -- | Create the empty graph. emptyGraph :: lg lb -- | Replace the existing arcs in the graph. setArcs :: lg lb -> [Arc lb] -> lg lb -- | Extract all the arcs from a graph getArcs :: lg lb -> [Arc lb] -- | Extract those arcs that match the given `Selector`. extract :: Selector lb -> lg lb -> lg lb extract sel = update (filter sel) -- | Add the two graphs addGraphs :: lg lb -> lg lb -> lg lb addGraphs addg = update (union (getArcs addg)) -- | Remove those arcs in the first graph from the second -- graph delete :: lg lb -- ^ g1 -> lg lb -- ^ g2 -> lg lb -- ^ g2 - g1 -> g3 delete delg = update (\\ getArcs delg) -- | 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 :: lg lb -> [lb] labels g = foldl' union [] (map arcLabels (getArcs g)) -- | Enumerate the distinct nodes contained in a graph; -- that is, any label that appears in the subject -- or object position of an `Arc`. nodes :: lg lb -> [lb] nodes g = foldl' union [] (map arcNodes (getArcs g)) -- | Update the arcs in a graph using a supplied function. update :: ([Arc lb] -> [Arc lb]) -> lg lb -> lg lb update f g = setArcs g ( f (getArcs g) ) -- | 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. class (Eq lb, Show lb, Ord 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 -- compare :: lb -> lb -> Ordering -- compare l1 l2 = compare (show l1) (show l2) -- | 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) instance (Hashable lb) => Hashable (Arc lb) where hash (Arc s p o) = hash s `hashWithSalt` p `hashWithSalt` o 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 (Arc s1 p1 o1) (Arc s2 p2 o2) | cs /= EQ = cs | cp /= EQ = cp | otherwise = co where cs = compare s1 s2 cp = compare p1 p2 co = compare o1 o2 {- not needed (Arc s1 p1 o1) <= (Arc s2 p2 o2) | s1 /= s2 = s1 <= s2 | p1 /= p2 = p1 <= p2 | otherwise = o1 <= o2 -} 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 -- --------------------------------------------------------------------------------