[Fencommits] fenfire-hs: finish and use new Graph implementation

Benja Fallenstein benja.fallenstein at gmail.com
Tue Mar 20 23:19:00 EET 2007


Tue Mar 20 23:18:23 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * finish and use new Graph implementation
diff -rN -u old-fenfire-hs/Fenfire/Main.hs new-fenfire-hs/Fenfire/Main.hs
--- old-fenfire-hs/Fenfire/Main.hs	2007-03-20 23:18:59.000000000 +0200
+++ new-fenfire-hs/Fenfire/Main.hs	2007-03-20 23:18:59.000000000 +0200
@@ -234,24 +234,25 @@
         "open"  -> confirmSave modified $ do 
             result <- liftIO $ openFile filepath
             maybeDo result $ \(g',fp') -> do
-                let ts = containsInfoTriples g'
-                    g'' = foldr insertVirtual g' ts
+                let g'' = mergeGraphs g' $ containsInfoTriples g'
                 put $ newState g'' (findStartPath Nothing g'') fp' focus
         "loadIRI" -> case node of 
                          IRI uri -> do 
                              g <- liftIO $ loadGraph uri
-                             let ts = containsInfoTriples g
-                                 g' = foldr insertVirtual 
-                                            (mergeGraphs graph g) ts
+                             let graph' = delete' (Any,Any,Any,node) graph
+                                 g' = mergeGraphs (mergeGraphs graph' g) $
+                                      containsInfoTriples g
                                  s' = state {fsGraph=g',
                                              fsUndo=(graph,path):fsUndo state,
                                              fsRedo=[]}
                              put s'
                          _ -> unhandledEvent
         "revert" | filepath /= "" -> confirmRevert modified $ do
-            g' <- liftIO $ loadGraph filepath
-            let g'' = foldr insertVirtual g' $ containsInfoTriples g'
-            put $ newState g'' (findStartPath Nothing g'') filepath focus
+            g <- liftIO $ loadGraph filepath
+            let graph' = delete' (Any,Any,Any,Dft) graph
+                g' = mergeGraphs (mergeGraphs graph' g) $ 
+                     containsInfoTriples g'
+            put $ newState g' (findStartPath Nothing g') filepath focus
         "save" | filepath /= "" -> do 
                      liftIO $ saveGraph graph filepath
                      modify $ \s -> s { fsGraphModified = False }
@@ -286,8 +287,8 @@
                       (showNode (graphNamespaces graph) node) $ \s -> do
                           let node' = interpretNode s
                               rot' = Rotation node' 0
-                              noinfo = all Map.null [getConns graph node' dir 
-                                                         | dir <- [Pos,Neg]] 
+                              noinfo = not $ iquery (node',Any,Any)
+                                          || iquery (Any,Any,node')
                           confirmFix "Load info about node"
                               noinfo (handleAction "loadIRI")
                               $ putRotation rot'
@@ -309,7 +310,7 @@
         putRotation rot   = do modify $ \s -> s { fsPath = toPath' rot }
                                setInterp True
         putMark mk        = do modify $ \state -> state { fsMark=mk }
-        delLit n graph = deleteAll n rdfs_label graph
+        delLit n graph = delete' (n, rdfs_label, Any) graph
 
 makeActions actionGroup accelGroup = do
     let actionentries = 
@@ -486,8 +487,7 @@
             let h x | List.isPrefixOf "http:" x = return x
                     | otherwise = Raptor.filenameToURI x
             uri <- h fileName
-            let ts = concatMap containsInfoTriples (g':gs)
-                graph = foldr insertVirtual (foldl mergeGraphs g' gs) ts
+            let graph = foldl mergeGraphs g' (gs ++ map containsInfoTriples (g':gs))
             newIORef $ newState graph (findStartPath (Just uri) graph) fileName False
 
     -- start:
diff -rN -u old-fenfire-hs/Fenfire/RDF.hs new-fenfire-hs/Fenfire/RDF.hs
--- old-fenfire-hs/Fenfire/RDF.hs	2007-03-20 23:18:59.000000000 +0200
+++ new-fenfire-hs/Fenfire/RDF.hs	2007-03-20 23:18:59.000000000 +0200
@@ -42,12 +42,13 @@
 
 import Network.URI hiding (query)
 
-data Node = IRI { nodeStr :: String }
-          | BNode { bnodeGraph :: String, nodeStr :: String } 
-          | Literal { nodeStr :: String, literalTag :: LiteralTag }
-                                                    deriving (Eq, Ord, Show, Read, Typeable, Data)
-data LiteralTag = Plain | Lang String | Type String deriving (Eq, Ord, Show, Read, Typeable, Data)
-data Dir  = Pos | Neg                               deriving (Eq, Ord, Show)
+data Node = IRI { iriStr :: String }
+          | BNode { bnodeGraph :: String, bnodeId :: String } 
+          | Literal { literalStr :: String, literalTag :: LiteralTag }
+     deriving (Eq, Ord, Show, Read, Typeable, Data)
+data LiteralTag = Plain | Lang String | Type String 
+     deriving (Eq, Ord, Show, Read, Typeable, Data)
+data Dir  = Pos | Neg  deriving (Eq, Ord, Show)
 
 {-instance Show Node where
     show = showNode defaultNamespaces-}
@@ -70,10 +71,6 @@
 
 type Triple     = (Node, Node, Node)
 type Namespaces = Map String String
-data Graph      = Graph {
-    graphNamespaces :: Namespaces, graphURI :: String,
-    graphSides :: Coin (Map Node (Map Node (Set Node))),
-    graphRealTriples :: Set Triple } deriving (Show, Read, Eq, Data, Typeable)
     
 data Conn = Conn { connProp :: Node, connDir :: Dir, connTarget :: Node }
             deriving (Eq, Ord, Show)
@@ -84,9 +81,6 @@
 pathToTriples (Path n (Conn p d n' : cs)) = 
     triple d (n,p,n') : pathToTriples (Path n' cs)
 
-instance CoinClass Graph (Map Node (Map Node (Set Node))) where
-    getSide dir graph = getSide dir $ graphSides graph
-    
 instance CoinClass Triple Node where
     getSide Neg = subject
     getSide Pos = object
@@ -163,33 +157,22 @@
 object :: Triple -> Node
 object (_,_,o) = o
 
-hasConn :: Graph -> Node -> Node -> Dir -> Bool
-hasConn g node prop dir = isJust $ do m <- Map.lookup node (getSide dir g)
-                                      s <- Map.lookup prop m
-                                      if Set.null s then Nothing else Just ()
-
-getOne :: Graph -> Node -> Node -> Dir -> Maybe Node
-getOne g node prop dir = if null nodes then Nothing else Just $ head nodes
-    where nodes = Set.toList (getAll g node prop dir)
-    
-getAll :: Graph -> Node -> Node -> Dir -> Set Node
-getAll g node prop dir = 
-    Map.findWithDefault Set.empty prop $ getConns g node dir
-
-getConns :: Graph -> Node -> Dir -> Map Node (Set Node)
-getConns g node dir = Map.findWithDefault Map.empty node $ getSide dir g
+fromGraph :: Pattern (Any,Any,Any,Any) r => Graph -> r
+fromGraph = query (Any,Any,Any,Any)
 
-emptyGraph :: Graph
-emptyGraph = Graph defaultNamespaces "" (Map.empty, Map.empty) Set.empty
+fromDefaultGraph :: Pattern (Any,Any,Any,Dft) r => Graph -> r
+fromDefaultGraph = query (Any,Any,Any,Dft)
 
-listToGraph :: [Triple] -> Graph
-listToGraph = foldr insert emptyGraph
+class ToGraph a where toGraph :: Node -> a -> Graph -- node = default graph
 
-graphToList :: Graph -> [Triple]
-graphToList = Set.toAscList . graphRealTriples
+instance ToGraph [Triple] where toGraph d = foldr insert (emptyGraph d)
+instance ToGraph [Quad]   where toGraph d = foldr insertQuad (emptyGraph d)
+instance ToGraph [x] => ToGraph (Set x) where 
+    toGraph d = toGraph d . Set.toList
+instance ToGraph [x] => ToGraph x where toGraph d x = toGraph d [x]
 
-mergeGraphs :: Op Graph
-mergeGraphs real virtual = foldr insertVirtual real (graphToList virtual)
+mergeGraphs :: Op Graph -- note: default graph and namespaces come from left
+mergeGraphs g h = foldr insertQuad g (fromGraph h)
 
 relativizeURI :: String -> Endo String
 relativizeURI baseURI s = fromMaybe s $ do
@@ -215,37 +198,31 @@
 changeBaseURI oldBase newBase = absolutizeNode newBase . relativizeNode oldBase
 
 setGraphURI :: String -> Endo Graph
-setGraphURI uri g = everywhere (mkT $ changeBaseURI (graphURI g) uri) $ 
-                    g { graphURI = uri }
+setGraphURI uri g = 
+    everywhereInGraph (changeBaseURI (iriStr $ defaultGraph g) uri) g
 
 insert :: Triple -> Endo Graph
-insert t graph@(Graph { graphRealTriples=ts }) =
-    insertVirtual t $ graph { graphRealTriples = Set.insert t ts }
+insert (s,p,o) g = insertQuad (s,p,o,defaultGraph g) g
 
-insertVirtual :: Triple -> Endo Graph
-insertVirtual (s,p,o) graph@(Graph { graphSides = (neg, pos) }) =
-    graph { graphSides = (ins o p s neg, ins s p o pos) } where
-    ins a b c = Map.alter (Just . Map.alter (Just . Set.insert c . fromMaybe Set.empty) b . fromMaybe Map.empty) a   -- Gack!!! Need to make more readable
-    
 delete :: Triple -> Endo Graph
-delete (s,p,o) (Graph ns uri (neg, pos) triples) = 
-    Graph ns uri (del o p s neg, del s p o pos) $ 
-        Set.delete (s,p,o) triples where
-    del a b c = Map.adjust (Map.adjust (Set.delete c) b) a
-    
-deleteAll :: Node -> Node -> Endo Graph
-deleteAll s p g = dels s p os g where
-    dels s' p' (o':os') g' = dels s' p' os' (delete (s',p',o') g')
-    dels _  _  []       g' = g'
-    os = Set.toList $ getAll g s p Pos
+delete (s,p,o) = delete' (s,p,o,Dft)
+
+delete' :: Pattern pat [Quad] => pat -> Endo Graph
+delete' pat g = foldr deleteQuad g (query pat g)
     
 update :: Triple -> Endo Graph
-update (s,p,o) g = insert (s,p,o) $ deleteAll s p g
+update (s,p,o) = insert (s,p,o) . delete' (s,p,Any,Dft)
+
+everywhereInGraph :: Endo Node -> Endo Graph
+everywhereInGraph f g = setNamespaces (graphNamespaces g) $
+                        toGraph (f $ defaultGraph g) $ everywhere (mkT f) $
+                        (fromGraph g :: [Quad])
 
 replaceNode :: Node -> Node -> Endo Graph
-replaceNode m n graph = Set.fold f graph (graphRealTriples graph) where
-    f (s,p,o) = insert (r s, r p, r o) . delete (s,p,o)
-    r x = if x == m then n else x
+replaceNode m n = everywhereInGraph $ \x -> if x == m then n else x
+
+setNamespaces :: Namespaces -> Endo Graph
+setNamespaces ns g = g { graphNamespaces = ns }
 
 addNamespace :: String -> String -> Endo Graph
 addNamespace prefix uri g =
@@ -268,7 +245,7 @@
 updateRDF :: (FromRDF a, ToRDF a) => Endo a -> Node -> Endo Graph
 updateRDF f node graph = graph' where
     (x, ts) = runFromRDF $ readRDF graph node
-    (_, ts') = runToRDF (graphURI graph) $ toRDF (f x)
+    (_, ts') = runToRDF (iriStr $ defaultGraph graph) $ toRDF (f x)
     graph' = flip (foldr insert) (Set.toAscList ts') $
              foldr delete graph (Set.toAscList ts)
 
@@ -305,8 +282,8 @@
 instance FromRDF a => FromRDF [a] where
     readRDF g l | l == rdf_nil = return []
                 | otherwise    = do
-        let first = fromJust $ getOne g l rdf_first Pos
-            rest  = fromJust $ getOne g l rdf_next Pos
+        first <- mquery (l, rdf_first, X) g
+        rest <- mquery (l, rdf_next, X) g
         tellTs [ (l, rdf_first, first), (l, rdf_next, rest) ]
         x  <- readRDF g first
         xs <- readRDF g rest
@@ -338,8 +315,9 @@
 --------------------------------------------------------------------------
 
 raptorToGraph :: [Raptor.Triple] -> [(String, String)] -> String -> Graph
-raptorToGraph raptorTriples namespaces graphURI' = setGraphURI graphURI' $
-        foldr (uncurry addNamespace) (listToGraph triples) namespaces where
+raptorToGraph raptorTriples namespaces graphURI' =
+       setNamespaces (Map.fromList namespaces) (toGraph g triples) where
+    g = IRI graphURI'
     triples = map convert raptorTriples
     convert (s,p,o) = (f s, f p, f o)
     f (Raptor.Uri s) = IRI s
@@ -348,15 +326,15 @@
     
 graphToRaptor :: Graph -> ([Raptor.Triple], [(String, String)])
 graphToRaptor graph = (map convert triples, namespaces) where
-    graphURI' = fromJust $ Network.URI.parseURI (graphURI graph)
+    graphURI' = fromJust $ Network.URI.parseURI (iriStr $ defaultGraph graph)
     convert (s,p,o) = (f s, f p, f o)
     f (IRI s) = Raptor.Uri $ fromMaybe s $ do
                     u <- Network.URI.parseURI s
                     return $ show $ Network.URI.relativeFrom u graphURI'
     f (Literal s _) = Raptor.Literal s
-    f (BNode g s) = if g == (graphURI graph) then Raptor.Blank s
+    f (BNode g s) = if g == (iriStr $ defaultGraph graph) then Raptor.Blank s
                     else error "XXX Cannot save bnode from different graph"
-    triples = graphToList graph
+    triples = query (Any,Any,Any,Dft) graph :: [Triple]
     namespaces = Map.toAscList $ graphNamespaces graph
 
 
@@ -364,6 +342,7 @@
 -- Writing Turtle
 --------------------------------------------------------------------------
 
+{-
 writeTurtle :: MonadWriter String m => String -> Graph -> m ()
 writeTurtle nl graph = do let graph' = listToGraph $ graphToList graph
                               nss = graphNamespaces graph
@@ -387,6 +366,7 @@
 writeTurtleObj nss o = do tell "    "; writeTurtleNode nss o
 
 writeTurtleNode nss node = tell $ showNode nss node
+-}
 
 
 --------------------------------------------------------------------------
@@ -394,8 +374,9 @@
 -- once it's finished
 --------------------------------------------------------------------------
 
-data Any = Any deriving (Eq, Ord, Show)
-data X = X     deriving (Eq, Ord, Show)
+data Any = Any   deriving (Eq, Ord, Show)
+data X = X       deriving (Eq, Ord, Show)
+data Dft = Dft deriving (Eq, Ord, Show) -- pattern matching the default graph
 
 -- Examples:
 -- query (x, rdf_type, X)   :: Graph -> Set Node
@@ -404,18 +385,27 @@
 -- query (x, rdf_type, Any) :: Graph -> Maybe Triple
 -- There are lots of other combinations.
 class Show pattern => Pattern pattern result where
-    query :: pattern -> Graph' -> result
+    query :: pattern -> Graph -> result
     
 type Quad = (Node, Node, Node, Node)
 
 quad2triple :: Quad -> Triple
 quad2triple (s,p,o,_) = (s,p,o)
 
+quadSubject :: Quad -> Node
+quadSubject (s,_,_,_) = s
+
+quadPredicate :: Quad -> Node
+quadPredicate (_,p,_,_) = p
+
+quadObject :: Quad -> Node
+quadObject (_,_,o,_) = o
+
 quadGraph :: Quad -> Node
 quadGraph (_,_,_,g) = g
 
-data Graph' = Graph' { defaultGraph :: String
-                   , namespaces' :: Map String String
+data Graph = Graph { defaultGraph :: Node
+                   , graphNamespaces :: Namespaces
                    , graphViews :: Map (Node, Node, Node, Node) (Set Quad)
                                :*: Map (Node, Node, Node, Any)  (Set Quad)
                                :*: Map (Node, Node, Any,  Node) (Set Quad)
@@ -433,12 +423,17 @@
                                :*: Map (Any,  Any,  Any,  Node) (Set Quad)
                                :*: Map (Any,  Any,  Any,  Any)  (Set Quad)
                                :*: HNil -- use some simple TH for this? :-)
-                   }
+                   } deriving (Eq, Typeable)
+                   
+instance Show Graph where
+    show g@(Graph d ns _) = "setNamespaces " ++ show ns ++ " (toGraph " ++
+                            show d++" "++show (fromGraph g :: [Quad])++")"
                    
 instance (Empty x, Empty xs) => Empty (HCons x xs) where 
     empty = HCons empty empty
 instance Empty HNil where empty = HNil
-instance Empty Graph' where empty = Graph' "" empty empty
+
+emptyGraph d = Graph d defaultNamespaces empty
 
 simpleQuery pattern g = 
     Map.findWithDefault Set.empty pattern $ hOccursFst (graphViews g)
@@ -476,33 +471,38 @@
          Pattern (s,p,o,X) (Set Node) where
     query (s,p,o,X) = Set.map quadGraph . query (s,p,o,Any)
     
-instance (Show s, Show p, Show o, Pattern (s,p,o,Any) r) => 
-         Pattern (s,p,o) r where
-    query (s,p,o) = query (s,p,o,Any)
+instance (Show s, Show p, Show o, Pattern (s,p,o,Node) (Set Quad)) =>
+         Pattern (s,p,o,Dft) (Set Quad) where
+    query (s,p,o,Dft) g = query (s, p, o, defaultGraph g) g
     
-instance (Show s, Show p, Show o, Pattern (s,p,o) r, Pattern (o,p,s) r) =>
-         Pattern (s,p,Dir,o) r where
-    query (o,p,Neg,s) = query (s,p,o)
-    query (s,p,Pos,o) = query (s,p,o)
+instance (Show s, Show p, Show o, Pattern (s,p,o,Any) (Set Quad)) => 
+         Pattern (s,p,o) (Set Quad) where
+    query (s,p,o) = query (s,p,o,Any)
+
+instance (Show s, Show p, Show o, Pattern (s,p,o,Any) (Set Node)) => 
+         Pattern (s,p,o) (Set Node) where
+    query (s,p,o) = query (s,p,o,Any)
+
 
 instance Pattern pat (Set Quad) => Pattern pat (Set Triple) where
     query pat = Set.map quad2triple . query pat
 
-instance (Pattern pat (Set r), MonadPlus m) => Pattern pat (m r) where
-    query pat = returnEach . Set.toList . query pat
-
-{- less generic versions, in case the above doesn't work out for some reason:
-instance (Pattern pat (Set r), MonadPlus m) => Pattern pat (m r) where
+instance Pattern pat (Set r) => Pattern pat [r] where
     query pat = Set.toList . query pat
 
-instance Pattern pat (Set r) => Pattern pat (Maybe r) where
-    query pat g = let s = query pat g in toMaybe (Set.null s) (Set.findMin s)
--}
+instance Pattern pat (Set r) => Pattern pat (Either String r) where
+    query pat g = let s = query pat g in 
+                  if Set.null s then Left $ "Pattern not found: " ++ show pat
+                                else Right $ Set.findMin s
+                                
+instance Pattern pat (Either String r) => Pattern pat (Maybe r) where
+    query = mquery
+    
+instance Pattern pat (Either String r) => Pattern pat r where
+    query pat g = either error id $ query pat g
     
-instance Pattern pat (Set r) => Pattern pat r where
-    query pat g = let s = query pat g in
-                  if Set.null s then error $ "Pattern not found: " ++ show pat
-                                else Set.findMin s
+mquery :: (Pattern pat (Either String r), Monad m) => pat -> Graph -> m r
+mquery pat g = either fail return $ query pat g
 
 instance Pattern pat (Set Quad) => Pattern pat Bool where
     query pat = not . Set.null . (id :: Endo (Set Quad)) . query pat
@@ -528,8 +528,8 @@
       updateWithDefault Set.empty (Set.delete (s,p,o,g))
         (toPatternSlot s, toPatternSlot p, toPatternSlot o, toPatternSlot g)
 
-insertQuad :: Quad -> Endo Graph'
+insertQuad :: Quad -> Endo Graph
 insertQuad q g = g { graphViews = hMap (InsertQuad q) $ graphViews g }
 
-deleteQuad :: Quad -> Endo Graph'
+deleteQuad :: Quad -> Endo Graph
 deleteQuad q g = g { graphViews = hMap (DeleteQuad q) $ graphViews g }
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs	2007-03-20 23:18:59.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs	2007-03-20 23:18:59.000000000 +0200
@@ -81,17 +81,21 @@
 dc_date = IRI "http://purl.org/dc/elements/1.1/date"
 dcterms_created = IRI "http://purl.org/dc/terms/created"
 
+iquery :: (Pattern pat r, ?graph :: Graph) => pat -> r
+iquery pat = query pat ?graph
+
 conns :: (?vs :: ViewSettings, ?graph :: Graph) => Node -> Dir -> [Path]
 conns node dir = Cache.cached (Cache.byAddress ?graph, (node,dir))
                               connsCache result where
     result = map (\(prop, node') -> Path node [Conn prop dir node']) sorted
     sorted = List.sortBy cmp' list
-    list = [(p,n) | (p,s) <- Map.toList $ getConns ?graph node dir,
-                    not (p `elem` hiddenProps ?vs), n <- Set.toList s]
+    query' (x,p,y) = case dir of Pos -> iquery (x,p,y); Neg -> iquery (y,p,x)
+    list = [(p,n) | p <- query' (node, X, Any),
+                    not (p `elem` hiddenProps ?vs), 
+                    n <- query' (node, p, X) ]
     cmp n1 n2 | Just d1 <- f n1, Just d2 <- f n2 = compare d1 d2 where
         f n = msum [g dc_date n, g dcterms_created n]
-        g prop n = if hasConn ?graph n prop Pos 
-                       then Just $ getOne ?graph n prop Pos else Nothing
+        g prop n = iquery (n, prop, X) :: Maybe Node
     cmp n1 n2 = compare (getText n1) (getText n2)
     cmp' (p1,n1) (p2,n2) = catOrds (cmp p1 p2) (cmp n1 n2)
     catOrds EQ o = o; catOrds o _ = o
@@ -107,7 +111,8 @@
                   return $ fromPath (rev path)
 
 getText :: (?graph :: Graph) => Node -> Maybe String
-getText n = fmap nodeStr $ getOne ?graph n rdfs_label Pos
+getText n = listToMaybe $ catMaybes $ map f $ iquery (n, rdfs_label, X) where
+    f (Literal s _) = Just s; f _ = Nothing
     
 getTextOrIRI :: (?graph :: Graph) => Node -> String
 getTextOrIRI n = fromMaybe (showNode (graphNamespaces ?graph) n) (getText n)
@@ -220,35 +225,34 @@
 
 newGraph :: (?uriMaker :: URIMaker) => IO (Graph, Path)
 newGraph = do
-    home <- liftM IRI newURI
-    let graph = listToGraph [(home, rdfs_label, Literal "" Plain)]
+    dftGraph <- liftM IRI newURI; home <- liftM IRI newURI
+    let graph = toGraph dftGraph [(home, rdfs_label, Literal "" Plain)]
     return (graph, Path home [])
     
 findStartPath :: (?vs :: ViewSettings) => Maybe String -> Graph -> Path
 findStartPath (Just uri) g = let ?graph = g in toPath' $ Rotation (IRI uri) 0
 findStartPath Nothing g = let ?graph = g in result where
     result :: (?graph :: Graph) => Path
-    result = head $ catMaybes $ startNode:topic:document:triples where
+    result = head $ catMaybes $ [startNode,topic,document] where
 
-    self = IRI $ graphURI g
+    self = defaultGraph g
 
-    startNode = fmap getRot' $ getTriple self ffv_startNode
-    topic = fmap getRot' $ getTriple self foaf_primaryTopic
-    document = toPath (Rotation self 0) Pos
-    triples = map (Just . getRot) $ graphToList g
-    
-    getTriple s p = fmap (\o -> (s,p,o)) $ getOne g s p Pos
-    getRot  (s,p,o) = Path s [Conn p Pos o]
-    getRot' (s,p,o) = Path o [Conn p Neg s]
+    startNode = fmap getRot $ getTriple self ffv_startNode
+    topic = fmap getRot $ getTriple self foaf_primaryTopic
+    document = Just (Path self [])
+    
+    getTriple s p = iquery (s,p,Any) :: Maybe Triple
+    getRot (s,p,o) = Path o [Conn p Neg s]
     
     ffv_startNode = IRI "http://fenfire.org/rdf-v/2003/05/ff#startNode"
     foaf_primaryTopic = IRI "http://xmlns.com/foaf/0.1/primaryTopic"
     
-containsInfoTriples :: (?vs :: ViewSettings) => Graph -> [Triple]
-containsInfoTriples g = [(s, p, o) | o <- os, o /= s] where
-    s = IRI $ graphURI g
+containsInfoTriples :: (?vs :: ViewSettings) => Graph -> Graph
+containsInfoTriples g = toGraph d [(s, p, o) | o <- os, o /= s] where
+    s = defaultGraph g
     p = IRI "ex:containsInformationAbout"
-    triples = graphToList g
+    d = IRI ("http://fenfire.org/2007/03/contains-info?" ++ iriStr s)
+    triples = fromDefaultGraph g :: [Triple]
     [subjects, objects] = for [subject, object] $ \f -> map f triples
     os = Set.toAscList $ foldr Set.delete (Set.fromList subjects) objects
 
@@ -272,10 +276,7 @@
 newState :: Graph -> Path -> FilePath -> Bool -> FenState
 newState graph path fp focus = 
     FenState graph path Set.empty fp False focus 0 rdfs_seeAlso ps [] []
-    where ps = Set.insert rdfs_seeAlso $ Set.fromList $
-                   map predicate $ filter f $ graphToList graph
-          f (_, _, IRI _) = True
-          f _             = False
+    where ps = Set.insert rdfs_seeAlso $ query (Any,X,Any) graph
 
 stateReplaceNode :: Node -> Node -> Endo FenState
 stateReplaceNode m n s@(FenState { fsPath = Path node cs }) = FenState {
diff -rN -u old-fenfire-hs/Makefile new-fenfire-hs/Makefile
--- old-fenfire-hs/Makefile	2007-03-20 23:18:59.000000000 +0200
+++ new-fenfire-hs/Makefile	2007-03-20 23:18:59.000000000 +0200
@@ -48,7 +48,7 @@
 	./dist/build/$</$< $(ARGS)
 	
 run-ghci: build install
-	ghci -lraptor
+	ghci -lraptor -fglasgow-exts Fenfire.hs
 
 run-project: fenfire ../fenfire-project/project.turtle darcs.nt
 	./dist/build/fenfire/fenfire ../fenfire-project/project.turtle darcs.nt $(ARGS)




More information about the Fencommits mailing list