{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : GraphClass -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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.RDF.GraphClass ( LDGraph(..), replaceArcs , Label(..) , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple , Selector , hasLabel, arcLabels -- , arcNodes ) where import qualified Data.Foldable as F import qualified Data.Traversable as T import Data.List (union, (\\)) -- | Labelled Directed Graph class -- -- Minimum required implementation: `setArcs`, `getArcs` and `containedIn`. -- -- 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. -- class (Eq (lg lb), Eq lb ) => LDGraph lg lb where -- empty graph -- emptyGr :: lg lb [[[TODO?]]] -- component-level operations -- | Replace the existing arcs in the graph. setArcs :: [Arc lb] -> lg 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 add :: lg lb -> lg lb -> lg lb add 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)) -- | Test for graph containment in another. containedIn :: lg lb -> lg lb -> Bool -- | Update the arcs in a graph using a supplied function. update :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb update f g = setArcs ( f (getArcs g) ) g -- |Function to replace arcs in a graph with a given list of arcs replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb replaceArcs gr as = update (const as) gr -- | 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 -- | 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 data Arc lb = Arc { asubj, apred, aobj :: lb } deriving (Eq, Functor, F.Foldable, T.Traversable) arcSubj :: Arc lb -> lb arcSubj = asubj arcPred :: Arc lb -> lb arcPred = apred arcObj :: Arc lb -> lb arcObj = aobj -- | 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 arcToTriple :: Arc lb -> (lb,lb,lb) arcToTriple a = (asubj a,apred a,aobj a) 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 ++")" type Selector lb = Arc lb -> Bool 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 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 -- --------------------------------------------------------------------------------