[Fencommits] fenfire-hs: more Fenfire refactoring, working towards a list view
Benja Fallenstein
benja.fallenstein at gmail.com
Mon Feb 19 15:24:39 EET 2007
Mon Feb 19 15:00:39 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* more Fenfire refactoring, working towards a list view
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs 2007-02-19 15:24:38.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs 2007-02-19 15:24:38.000000000 +0200
@@ -20,7 +20,7 @@
-- MA 02111-1307 USA
import qualified Cache
-import Cairo hiding (rotate)
+import Cairo hiding (rotate, Path)
import Vobs
import Utils
import RDF
@@ -41,7 +41,7 @@
import Data.Monoid(Monoid(mempty, mconcat), Dual(Dual), getDual)
import Control.Applicative
-import Control.Monad (when, guard, msum, liftM, join)
+import Control.Monad (when, guard, mplus, msum, liftM, join)
import Control.Monad.Reader (ReaderT, runReaderT, local, ask, asks)
import Control.Monad.State (StateT, get, gets, modify, put, execStateT)
import Control.Monad.Trans (lift, liftIO)
@@ -76,25 +76,28 @@
data Rotation = Rotation Node Int deriving (Eq, Show)
-fromEdge :: (?vs :: ViewSettings, ?graph :: Graph) => Edge -> Maybe Rotation
-fromEdge (node, prop, dir, node') = let c = conns node dir in do
- i <- Data.List.elemIndex (prop, node') c
+fromPath :: (?vs :: ViewSettings, ?graph :: Graph) => Path -> Maybe Rotation
+fromPath path@(Path node (Conn _ dir _ : _)) = do
+ let c = conns node dir
+ i <- Data.List.elemIndex path c
return $ Rotation node (i - min (length c `div` 2) (maxCenter ?vs))
+fromPath _ = error "Fenfire.fromPath: empty path"
-toEdge :: (?vs :: ViewSettings, ?graph :: Graph) => Rotation -> Dir -> Maybe Edge
-toEdge (Rotation node r) dir = let c = conns node dir in do
- (prop, node') <- c !? (min (length c `div` 2) (maxCenter ?vs) + r)
- return (node, prop, dir, node')
+toPath :: (?vs :: ViewSettings, ?graph :: Graph) =>
+ Rotation -> Dir -> Maybe Path
+toPath (Rotation node r) dir = let c = conns node dir in
+ c !? (min (length c `div` 2) (maxCenter ?vs) + r)
-connsCache :: Cache.Cache (StableName Graph, (Node, Dir)) [(Node, Node)]
+connsCache :: Cache.Cache (StableName Graph, (Node, Dir)) [Path]
connsCache = Cache.newCache 10000
dc_date = URI "dc:date"
-conns :: (?vs :: ViewSettings, ?graph :: Graph) => Node -> Dir -> [(Node, Node)]
+conns :: (?vs :: ViewSettings, ?graph :: Graph) => Node -> Dir -> [Path]
conns node dir = Cache.cached (Cache.byAddress ?graph, (node,dir))
connsCache result where
- result = Data.List.sortBy cmp' list
+ result = map (\(prop, node') -> Path node [Conn prop dir node']) sorted
+ sorted = Data.List.sortBy cmp' list
list = [(p,n) | (p,s) <- Map.toList $ getConns ?graph node dir,
not (p `elem` hiddenProps ?vs), n <- Set.toList s]
cmp n1 n2 | p n1 && p n2 = compare (f n1) (f n2) where
@@ -106,11 +109,12 @@
rotate :: (?vs :: ViewSettings, ?graph :: Graph) =>
Rotation -> Int -> Maybe Rotation
rotate (Rotation n r) dir = let rot = Rotation n (r+dir) in do
- guard $ any isJust [toEdge rot d | d <- [Pos, Neg]]; return rot
+ guard $ any isJust [toPath rot d | d <- [Pos, Neg]]; return rot
move :: (?vs :: ViewSettings, ?graph :: Graph) =>
Rotation -> Dir -> Maybe Rotation
-move rot dir = join $ fmap fromEdge $ fmap rev $ toEdge rot dir
+move rot dir = do path <- toPath rot dir
+ fromPath (rev path)
getText :: (?graph :: Graph) => Node -> Maybe String
getText n = fmap f $ getOne ?graph n rdfs_label Pos where
@@ -162,8 +166,8 @@
placeConns' rotation' xdir ydir
-- place one subtree
placeConn rotation@(Rotation n1 _) dir = withDepthIncreased 1 $
- maybeDo (toEdge rotation dir) $ \edge@(_, prop, _, n2) -> do
- let rotation' = fromJust $ fromEdge (rev edge)
+ maybeDo (toPath rotation dir) $ \path@(Path _ [Conn prop _ n2]) -> do
+ let rotation' = fromJust $ fromPath (rev path)
scale' <- getScale
withCenterMoved dir (280 * (scale'**3)) $ do
ifUnvisited n2 $ placeNode Nothing rotation'
@@ -266,8 +270,8 @@
result :: (?graph :: Graph) => Vob Node
result = cursor & vob where
Rotation node _ = fsRotation state
- children = map snd (conns node Pos)
- selected = fmap (getSide Pos) (toEdge (fsRotation state) Pos)
+ children = map getPos (conns node Pos)
+ selected = fmap (getSide Pos) (toPath (fsRotation state) Pos)
f sc n = keyVob n $ useFgColor $ pad 5 $ scaleVob sc $
multiline True 70 $ getTextOrURI n
cursor = flip (maybe mempty) selected $ \n ->
@@ -305,7 +309,7 @@
node' <- newURI
let ?graph = insert (triple dir (node, prop, node'))
$ insert (node', rdfs_label, PlainLiteral "") graph
- in return (?graph, fromJust $ fromEdge (node', prop, rev dir, node))
+ in return (?graph, fromJust $ fromPath (Path node' [Conn prop (rev dir) node]))
connect :: (?vs :: ViewSettings) => Dir -> Endo FenState
connect _ state | Set.null (fsMark state) = state
@@ -313,24 +317,22 @@
let nodes = Set.toList (fsMark state); prop = fsProperty state in
let ?graph = foldr (\n -> insert $ triple dir (node, prop, n))
(fsGraph state) nodes in
- state { fsRotation = fromJust $ fromEdge (node, prop, dir, head nodes),
+ state { fsRotation = fromJust $ fromPath (Path node [Conn prop dir (head nodes)]),
fsGraph = ?graph, fsMark = Set.empty }
disconnect :: (?vs :: ViewSettings) => Dir -> Endo FenState
-disconnect dir state@(FenState { fsRotation=Rotation node rot }) =
- let
- c = (let ?graph = fsGraph state in conns node dir)
- index = min (length c `div` 2) (maxCenter ?vs) + rot
- (p,n) = c !! index
- graph' = delete (triple dir (node, p, n)) (fsGraph state)
- index' = min ((length c - 1) `div` 2) (maxCenter ?vs) + rot
- rot' = case index' of x | x == -1 -> rot+1
- | x == length c - 1 && x /= 0 -> rot-1
- | otherwise -> rot
- in state { fsGraph=graph',
- fsRotation = if index >= 0 && index < length c
- then Rotation node rot'
- else findStartRotation graph' }
+disconnect dir state@(FenState { fsRotation=rot@(Rotation node _) }) =
+ let ?graph = fsGraph state in
+ case toPath rot dir of
+ Nothing -> state
+ Just path ->
+ let path' = msum [flip toPath xdir =<< rotate rot ydir |
+ xdir <- [Neg,Pos], ydir <- [-1,1]]
+ triples = pathToTriples path
+ graph' = foldr delete (fsGraph state) triples
+ rot' = fromMaybe (Rotation node 0) $
+ let ?graph = graph' in fromPath =<< path'
+ in state { fsGraph=graph', fsRotation=rot', fsGraphModified=True }
type Mark = Set Node
@@ -356,7 +358,7 @@
triples = map getRot $ graphToList g
getTriple s p = fmap (\o -> (s,p,o)) $ getOne g s p Pos
- getRot (s,p,o) = fromEdge (o, p, Neg, s)
+ getRot (s,p,o) = fromPath (Path o [Conn p Neg s])
ffv_startNode = URI "http://fenfire.org/rdf-v/2003/05/ff#startNode"
foaf_primaryTopic = URI "http://xmlns.com/foaf/0.1/primaryTopic"
diff -rN -u old-fenfire-hs/RDF.hs new-fenfire-hs/RDF.hs
--- old-fenfire-hs/RDF.hs 2007-02-19 15:24:38.000000000 +0200
+++ new-fenfire-hs/RDF.hs 2007-02-19 15:24:38.000000000 +0200
@@ -39,6 +39,9 @@
class CoinClass c a | c -> a where
getSide :: Dir -> c -> a
+ getNeg :: c -> a; getNeg = getSide Neg
+ getPos :: c -> a; getPos = getSide Pos
+
type Coin a = (a,a)
instance CoinClass (Coin a) a where
@@ -53,8 +56,14 @@
graphSides :: Coin (Map Node (Map Node (Set Node))),
graphRealTriples :: Set Triple } deriving (Show, Eq)
-type Edge = (Node, Node, Dir, Node)
-type Path = [Edge]
+data Conn = Conn { connProp :: Node, connDir :: Dir, connTarget :: Node }
+ deriving (Eq, Ord, Show)
+data Path = Path Node [Conn] deriving (Eq, Ord, Show)
+
+pathToTriples :: Path -> [Triple]
+pathToTriples (Path _ []) = []
+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
@@ -63,34 +72,20 @@
getSide Neg = subject
getSide Pos = object
-instance CoinClass Edge Node where
- getSide Neg (n,_,_,_) = n
- getSide Pos (_,_,_,n') = n'
-
instance CoinClass Path Node where
- getSide Neg path = getSide Neg (head path)
- getSide Pos path = getSide Pos (last path)
+ getSide Neg (Path node _) = node
+ getSide Pos (Path node []) = node
+ getSide Pos (Path _ conns) = connTarget (last conns)
-class TripleClass t where
- toTriple :: t -> Triple
-
-instance TripleClass Triple where
- toTriple = id
-
-instance TripleClass Edge where
- toTriple (n,p,d,n') = triple d (n,p,n')
-
class Reversible r where
rev :: Endo r
instance Reversible Dir where
rev Neg = Pos; rev Pos = Neg
-instance Reversible Edge where
- rev (node, prop, dir, node') = (node', prop, rev dir, node)
-
instance Reversible Path where
- rev edges = reverse (map rev edges)
+ rev (Path node conns) = foldr f (Path node []) (reverse conns) where
+ f (Conn p d n') (Path n cs) = Path n' (Conn p (rev d) n : cs)
instance Hashable Node where
hash (URI s) = hash s
@@ -114,14 +109,14 @@
f [] = "<" ++ uri ++ ">"
showNode _ (PlainLiteral lit) = show lit
-subject :: TripleClass t => t -> Node
-subject t = case toTriple t of (s,_,_) -> s
+subject :: Triple -> Node
+subject (s,_,_) = s
-predicate :: TripleClass t => t -> Node
-predicate t = case toTriple t of (_,p,_) -> p
+predicate :: Triple -> Node
+predicate (_,p,_) = p
-object :: TripleClass t => t -> Node
-object t = case toTriple t of (_,_,o) -> o
+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)
More information about the Fencommits
mailing list