[Fencommits] fenfire-hs: namespace support; files are now saved as turtle
Benja Fallenstein
benja.fallenstein at gmail.com
Sun Feb 18 12:26:51 EET 2007
Sun Feb 18 12:25:24 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* namespace support; files are now saved as turtle
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs 2007-02-18 12:26:50.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs 2007-02-18 12:26:50.000000000 +0200
@@ -114,17 +114,19 @@
getText :: Graph -> Node -> Maybe String
getText g n = fmap f $ getOne g n rdfs_label Pos where
f (PlainLiteral s) = s; f _ = error "getText argh"
+
+getTextOrURI :: Graph -> Node -> String
+getTextOrURI g n = fromMaybe (showNode (getNamespaces g) n) (getText g n)
setText :: Graph -> Node -> String -> Graph
setText g n t = update (n, rdfs_label, PlainLiteral t) g
nodeView :: Graph -> Node -> Vob Node
-nodeView g n = useFgColor $ multiline False 20 s
- where s = maybe (show n) id (getText g n)
+nodeView g n = useFgColor $ multiline False 20 $ getTextOrURI g n
propView :: Graph -> Node -> Vob Node
propView g n = (useFadeColor $ fill extents)
- & (pad 5 $ useFgColor $ label $ maybe (show n) id (getText g n))
+ & (pad 5 $ useFgColor $ label $ getTextOrURI g n)
@@ -264,7 +266,7 @@
selected = fmap (\(_,Rotation _ n _) -> n) $
getConn (fsRotation state) Pos
f sc n = keyVob n $ useFgColor $ pad 5 $ scaleVob sc $
- multiline True 70 $ maybe (show n) id (getText graph n)
+ multiline True 70 $ getTextOrURI graph n
cursor = flip (maybe mempty) selected $ \n ->
showAtKey n $ keyVob (PlainLiteral "CURSOR") $ rectBox mempty
space = changeSize (const (0, 20)) mempty
@@ -363,11 +365,11 @@
f (Raptor.Uri s) = URI s
f (Raptor.Literal s) = PlainLiteral s
f (Raptor.Blank s) = URI $ "blank:" ++ s
- raptorTriples <- if Data.List.isPrefixOf "http:" fileName
+ (raptorTriples, namespaces) <- if Data.List.isPrefixOf "http:" fileName
then Raptor.uriToTriples fileName Nothing
else Raptor.filenameToTriples fileName (Just "fakebase:/")
triples <- return $ map convert raptorTriples
- return $ listToGraph triples
+ return $ foldr (uncurry addNamespace) (listToGraph triples) namespaces
saveGraph :: Graph -> FilePath -> IO ()
saveGraph graph fileName = do
@@ -376,7 +378,8 @@
f (URI s) = Raptor.Uri s
f (PlainLiteral s) = Raptor.Literal s
triples = graphToList graph
- Raptor.triplesToFilename (map convert triples) fileName
+ namespaces = Map.toAscList $ getNamespaces graph
+ Raptor.triplesToFilename (map convert triples) namespaces fileName
putStrLn $ "Saved: " ++ fileName
openFile :: (?vs :: ViewSettings) => Rotation -> FilePath ->
@@ -506,14 +509,14 @@
"open" -> confirmSave modified $ do
(rot',fp') <- liftIO $ openFile rot filepath
put $ newState rot' fp' focus
- "loadURI" -> case node of URI uri -> do g <- liftIO $ loadGraph uri
- let ts = graphToList g
- g' = foldr insertVirtual
- graph ts
- r' = Rotation g' node r
- s' = state {fsRotation=r'}
- put s'
- _ -> unhandledEvent
+ "loadURI" -> case node of
+ URI uri -> do
+ g <- liftIO $ loadGraph uri
+ let g' = mergeGraphs graph g
+ r' = Rotation g' node r
+ s' = state {fsRotation=r'}
+ put s'
+ _ -> unhandledEvent
"revert" | filepath /= "" -> confirmRevert modified $ do
g' <- liftIO $ loadGraph filepath
put $ newState (findStartRotation g') filepath focus
@@ -577,8 +580,7 @@
menu <- menuNew
flip mapM (fsPropertyList state) $ \prop -> do
- let text = getText graph prop
- item <- menuItemNewWithLabel $ fromMaybe (show prop) text
+ item <- menuItemNewWithLabel $ getTextOrURI graph prop
onActivateLeaf item $ do
modifyIORef stateRef $ \state' -> state' {fsProperty=prop}
updateCanvas False
diff -rN -u old-fenfire-hs/Makefile new-fenfire-hs/Makefile
--- old-fenfire-hs/Makefile 2007-02-18 12:26:50.000000000 +0200
+++ new-fenfire-hs/Makefile 2007-02-18 12:26:50.000000000 +0200
@@ -39,8 +39,8 @@
run-%: %
./dist/build/$</$< $(ARGS)
-run-project: fenfire ../fenfire-project/project.nt darcs.nt
- ./dist/build/fenfire/fenfire ../fenfire-project/project.nt darcs.nt $(ARGS)
+run-project: fenfire ../fenfire-project/project.turtle darcs.nt
+ ./dist/build/fenfire/fenfire ../fenfire-project/project.turtle darcs.nt $(ARGS)
darcs.nt: darcs2rdf _darcs/inventory
darcs changes --xml | ./dist/build/darcs2rdf/darcs2rdf "http://antti-juhani.kaijanaho.fi/darcs/fenfire-hs/" > darcs.nt
diff -rN -u old-fenfire-hs/Raptor.chs new-fenfire-hs/Raptor.chs
--- old-fenfire-hs/Raptor.chs 2007-02-18 12:26:50.000000000 +0200
+++ new-fenfire-hs/Raptor.chs 2007-02-18 12:26:50.000000000 +0200
@@ -59,6 +59,11 @@
unStatement :: Statement -> Ptr Statement
unStatement (Statement ptr) = ptr
+{#pointer *raptor_namespace as Namespace newtype#}
+
+unNamespace :: Namespace -> Ptr Namespace
+unNamespace (Namespace ptr) = ptr
+
{#pointer *parser as Parser newtype#}
{#pointer *serializer as Serializer newtype#}
@@ -96,6 +101,15 @@
getObject :: Statement -> IO Identifier
getObject (Statement s) = mkIdentifier ({#get statement->object#} s)
({#get statement->object_type#} s)
+
+getNamespace :: Namespace -> IO (String, String)
+getNamespace ns = do
+ prefixC <- {#call raptor_namespace_get_prefix#} ns
+ prefixS <- peekCString (castPtr prefixC)
+ uri <- {#call raptor_namespace_get_uri#} ns
+ uriC <- {#call uri_as_string#} (castPtr uri)
+ uriS <- peekCString (castPtr uriC)
+ return (prefixS, uriS)
withURI :: String -> (Ptr URI -> IO a) -> IO a
withURI string = bracket (withCString string $ {# call new_uri #} . castPtr)
@@ -126,13 +140,18 @@
withObject = withIdentifier {# set statement->object #}
{# set statement->object_type #}
-type Handler a = Ptr a -> Statement -> IO ()
+type StatementHandler a = Ptr a -> Statement -> IO ()
foreign import ccall "wrapper"
- mkHandler :: (Handler a) -> IO (FunPtr (Handler a))
+ mkHandler :: (StatementHandler a) -> IO (FunPtr (StatementHandler a))
+
+type NamespaceHandler a = Ptr a -> Namespace -> IO ()
+foreign import ccall "wrapper"
+ mkNamespaceHandler :: (NamespaceHandler a) -> IO (FunPtr (NamespaceHandler a))
foreign import ccall "raptor.h raptor_init" initRaptor :: IO ()
foreign import ccall "raptor.h raptor_new_parser" new_parser :: Ptr CChar -> IO (Ptr Parser)
-foreign import ccall "raptor.h raptor_set_statement_handler" set_statement_handler :: Ptr Parser -> Ptr a -> FunPtr (Handler a) -> IO ()
+foreign import ccall "raptor.h raptor_set_statement_handler" set_statement_handler :: Ptr Parser -> Ptr a -> FunPtr (StatementHandler a) -> IO ()
+foreign import ccall "raptor.h raptor_set_namespace_handler" set_namespace_handler :: Ptr Parser -> Ptr a -> FunPtr (NamespaceHandler a) -> IO ()
foreign import ccall "raptor.h raptor_uri_filename_to_uri_string" uri_filename_to_uri_string :: CString -> IO CString
foreign import ccall "raptor.h raptor_new_uri" new_uri :: Ptr CChar -> IO (Ptr URI)
foreign import ccall "raptor.h raptor_uri_copy" uri_copy :: Ptr URI -> IO (Ptr URI)
@@ -149,14 +168,20 @@
-- | Serialize the given triples into a file with the given filename
--
-triplesToFilename :: [Triple] -> String -> IO ()
-triplesToFilename triples filename = do
+triplesToFilename :: [Triple] -> [(String, String)] -> String -> IO ()
+triplesToFilename triples namespaces filename = do
initRaptor
- serializer <- withCString "ntriples" {# call new_serializer #}
+ serializer <- withCString "turtle" {# call new_serializer #}
when (unSerializer serializer == nullPtr) $ fail "serializer is null"
withCString filename $ {# call serialize_start_to_filename #} serializer
+
+ flip mapM_ namespaces $ \(prefixS, uriS) -> do
+ withCString prefixS $ \prefixC -> withCString uriS $ \uriC -> do
+ uri <- new_uri uriC
+ {# call raptor_serialize_set_namespace #} serializer uri $ castPtr prefixC
+ {# call free_uri #} uri
allocaBytes {# sizeof statement #} $ \ptr -> do
let t = Statement ptr
@@ -171,7 +196,7 @@
-- | Parse a file with the given filename into triples
--
-filenameToTriples :: String -> Maybe String -> IO [Triple]
+filenameToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
filenameToTriples filename baseURI = do
let suffix = reverse $ takeWhile (/= '.') $ reverse filename
parsertype = case suffix of "turtle" -> "turtle"
@@ -193,9 +218,9 @@
{# call free_memory #} (castPtr uri_str)
{# call finish #}
- readIORef result
+ return result
-uriToTriples :: String -> Maybe String -> IO [Triple]
+uriToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
uriToTriples uri baseURI = do
initRaptor
@@ -208,12 +233,13 @@
{# call free_uri #} base_uri
{# call finish #}
- readIORef result
+ return result
parse :: (Ptr Parser -> Ptr URI -> Ptr URI -> IO ()) -> String ->
- Ptr URI -> Ptr URI -> IO (IORef [Triple])
+ Ptr URI -> Ptr URI -> IO ([Triple], [(String, String)])
parse fn parsertype uri base_uri = do
- result <- newIORef []
+ triples <- newIORef []
+ namespaces <- newIORef []
rdf_parser <- withCString parsertype new_parser
when (rdf_parser == nullPtr) $ fail "parser is null"
@@ -221,20 +247,26 @@
s <- getSubject triple
p <- getPredicate triple
o <- getObject triple
- modifyIORef result ((s,p,o):)
+ modifyIORef triples ((s,p,o):)
+
+ nsHandler <- mkNamespaceHandler $ \_user_data ns -> do
+ (prefix, uri') <- getNamespace ns
+ modifyIORef namespaces ((prefix, uri'):)
set_statement_handler rdf_parser nullPtr handler
+ set_namespace_handler rdf_parser nullPtr nsHandler
fn rdf_parser uri base_uri
{# call free_parser #} (Parser rdf_parser)
freeHaskellFunPtr handler
- return result
+ t <- readIORef triples; n <- readIORef namespaces
+ return (t, n)
-- The following print_triple and filenameToStdout are an incomplete and
-- improved translation of raptor examples/rdfprint.c:
-print_triple :: Ptr CFile -> Handler a
+print_triple :: Ptr CFile -> StatementHandler a
print_triple outfile _user_data s = do print_statement_as_ntriples s outfile
fputc (castCharToCChar '\n') outfile
diff -rN -u old-fenfire-hs/RDF.hs new-fenfire-hs/RDF.hs
--- old-fenfire-hs/RDF.hs 2007-02-18 12:26:50.000000000 +0200
+++ new-fenfire-hs/RDF.hs 2007-02-18 12:26:50.000000000 +0200
@@ -31,12 +31,12 @@
data Dir = Pos | Neg deriving (Eq, Ord, Show)
instance Show Node where
- show (URI uri) = showURI [("rdfs", rdfs)] uri
- show (PlainLiteral s) = "\"" ++ s ++ "\""
+ show = showNode defaultNamespaces
type Triple = (Node, Node, Node)
type Side = Map Node (Map Node (Set Node))
-data Graph = Graph Side Side (Set Triple) deriving (Show, Eq)
+type Namespaces = Map String String
+data Graph = Graph Namespaces Side Side (Set Triple) deriving (Show, Eq)
instance Hashable Node where
hash (URI s) = hash s
@@ -50,10 +50,15 @@
rdfs_label = URI "http://www.w3.org/2000/01/rdf-schema#label"
rdfs_seeAlso = URI "http://www.w3.org/2000/01/rdf-schema#seeAlso"
-showURI ((short, long):xs) uri | take (length long) uri == long =
- short ++ ":" ++ drop (length long) uri
- | otherwise = showURI xs uri
-showURI [] uri = "<" ++ uri ++ ">"
+defaultNamespaces = Map.fromList [("rdfs", rdfs)]
+
+showNode :: Namespaces -> Node -> String
+showNode ns (URI uri) = f (Map.toAscList ns) where
+ f ((short, long):xs) | take (length long) uri == long =
+ short ++ ":" ++ drop (length long) uri
+ | otherwise = f xs
+ f [] = "<" ++ uri ++ ">"
+showNode _ (PlainLiteral lit) = show lit
subject :: Triple -> Node
subject (s,_,_) = s
@@ -65,8 +70,8 @@
object (_,_,o) = o
graphSide :: Dir -> Graph -> Side
-graphSide Neg (Graph s _ _) = s
-graphSide Pos (Graph _ s _) = s
+graphSide Neg (Graph _ s _ _) = s
+graphSide Pos (Graph _ _ s _) = s
hasConn :: Graph -> Node -> Node -> Dir -> Bool
hasConn g node prop dir = isJust $ do m <- Map.lookup node (graphSide dir g)
@@ -83,40 +88,47 @@
getConns :: Graph -> Node -> Dir -> Map Node (Set Node)
getConns g node dir = Map.findWithDefault Map.empty node $ graphSide dir g
+getNamespaces :: Graph -> Namespaces
+getNamespaces (Graph ns _ _ _) = ns
+
emptyGraph :: Graph
-emptyGraph = Graph (Map.empty) (Map.empty) Set.empty
+emptyGraph = Graph defaultNamespaces (Map.empty) (Map.empty) Set.empty
listToGraph :: [Triple] -> Graph
listToGraph = foldr insert emptyGraph
graphToList :: Graph -> [Triple]
-graphToList (Graph _ _ triples) = Set.toAscList triples
+graphToList (Graph _ _ _ triples) = Set.toAscList triples
mergeGraphs :: Op Graph
-mergeGraphs g1 g2 = foldr insertVirtual g1 (graphToList g2)
+mergeGraphs real virtual = foldr insertVirtual real (graphToList virtual)
-insert :: Triple -> Graph -> Graph
-insert t (Graph neg pos triples) =
- insertVirtual t (Graph neg pos $ Set.insert t triples)
-
-insertVirtual :: Triple -> Graph -> Graph
-insertVirtual (s,p,o) (Graph neg pos triples) =
- Graph (ins o p s neg) (ins s p o pos) triples where
+insert :: Triple -> Endo Graph
+insert t (Graph ns neg pos triples) =
+ insertVirtual t (Graph ns neg pos $ Set.insert t triples)
+
+insertVirtual :: Triple -> Endo Graph
+insertVirtual (s,p,o) (Graph ns neg pos triples) =
+ Graph ns (ins o p s neg) (ins s p o pos) triples 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 -> Graph -> Graph
-delete (s,p,o) (Graph neg pos triples) =
- Graph (del o p s neg) (del s p o pos) $ Set.delete (s,p,o) triples where
+delete :: Triple -> Endo Graph
+delete (s,p,o) (Graph ns neg pos triples) =
+ Graph ns (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 -> Graph -> Graph
+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
-update :: Triple -> Graph -> Graph
+update :: Triple -> Endo Graph
update (s,p,o) g = insert (s,p,o) $ deleteAll s p g
+
+addNamespace :: String -> String -> Endo Graph
+addNamespace prefix uri (Graph ns neg pos ts) =
+ Graph (Map.insert prefix uri ns) neg pos ts
triple :: Dir -> (Node,Node,Node) -> Triple
triple Pos (s,p,o) = (s,p,o)
More information about the Fencommits
mailing list