[Fencommits] fenfire-hs: RDF code tweaks
Benja Fallenstein
benja.fallenstein at gmail.com
Sat Mar 17 01:16:12 EET 2007
Sat Mar 17 01:15:49 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* RDF code tweaks
diff -rN -u old-fenfire-hs/Fenfire/RDF.hs new-fenfire-hs/Fenfire/RDF.hs
--- old-fenfire-hs/Fenfire/RDF.hs 2007-03-17 01:16:11.000000000 +0200
+++ new-fenfire-hs/Fenfire/RDF.hs 2007-03-17 01:16:11.000000000 +0200
@@ -67,7 +67,7 @@
type Triple = (Node, Node, Node)
type Namespaces = Map String String
data Graph = Graph {
- graphNamespaces :: Namespaces,
+ graphNamespaces :: Namespaces, graphURI :: String,
graphSides :: Coin (Map Node (Map Node (Set Node))),
graphRealTriples :: Set Triple } deriving (Show, Eq)
@@ -176,7 +176,7 @@
getConns g node dir = Map.findWithDefault Map.empty node $ getSide dir g
emptyGraph :: Graph
-emptyGraph = Graph defaultNamespaces (Map.empty, Map.empty) Set.empty
+emptyGraph = Graph defaultNamespaces "" (Map.empty, Map.empty) Set.empty
listToGraph :: [Triple] -> Graph
listToGraph = foldr insert emptyGraph
@@ -187,6 +187,9 @@
mergeGraphs :: Op Graph
mergeGraphs real virtual = foldr insertVirtual real (graphToList virtual)
+setGraphURI :: String -> Endo Graph
+setGraphURI uri g = g { graphURI = uri }
+
insert :: Triple -> Endo Graph
insert t graph@(Graph { graphRealTriples=ts }) =
insertVirtual t $ graph { graphRealTriples = Set.insert t ts }
@@ -197,8 +200,8 @@
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 (neg, pos) triples) =
- Graph ns (del o p s neg, del s p o pos) $
+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
@@ -234,6 +237,13 @@
-- FromRDF and ToRDF
--------------------------------------------------------------------------
+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)
+ graph' = flip (foldr insert) (Set.toAscList ts') $
+ foldr delete graph (Set.toAscList ts)
+
type FromRdfM = Writer (Set Triple)
class FromRDF a where -- minimal impl: either fromRDF or readRDF
@@ -277,8 +287,7 @@
instance ToRDF a => ToRDF [a] where
toRDF [] = return rdf_nil
toRDF (x:xs) = do l <- newBNode; first <- toRDF x; next <- toRDF xs
- tellTs [ (l, rdf_type, rdf_List)
- , (l, rdf_first, first)
+ tellTs [ (l, rdf_first, first)
, (l, rdf_next, next) ]
return l
@@ -295,23 +304,23 @@
--------------------------------------------------------------------------
raptorToGraph :: [Raptor.Triple] -> [(String, String)] -> String -> Graph
-raptorToGraph raptorTriples namespaces graphURI =
+raptorToGraph raptorTriples namespaces graphURI' = setGraphURI graphURI' $
foldr (uncurry addNamespace) (listToGraph triples) namespaces where
triples = map convert raptorTriples
convert (s,p,o) = (f s, f p, f o)
f (Raptor.Uri s) = IRI s
f (Raptor.Literal s) = Literal s Plain
- f (Raptor.Blank s) = BNode graphURI s
+ f (Raptor.Blank s) = BNode graphURI' s
-graphToRaptor :: Graph -> String -> ([Raptor.Triple], [(String, String)])
-graphToRaptor graph graphURI = (map convert triples, namespaces) where
- graphURI' = fromJust $ Network.URI.parseURI graphURI
+graphToRaptor :: Graph -> ([Raptor.Triple], [(String, String)])
+graphToRaptor graph = (map convert triples, namespaces) where
+ graphURI' = fromJust $ Network.URI.parseURI (graphURI 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 then Raptor.Blank s
+ f (BNode g s) = if g == (graphURI graph) then Raptor.Blank s
else error "XXX Cannot save bnode from different graph"
triples = graphToList graph
namespaces = Map.toAscList $ graphNamespaces graph
diff -rN -u old-fenfire-hs/Fenfire/Raptor.chs new-fenfire-hs/Fenfire/Raptor.chs
--- old-fenfire-hs/Fenfire/Raptor.chs 2007-03-17 01:16:11.000000000 +0200
+++ new-fenfire-hs/Fenfire/Raptor.chs 2007-03-17 01:16:11.000000000 +0200
@@ -26,6 +26,8 @@
allocaBytes, nullPtr, castPtr, freeHaskellFunPtr, malloc, peek)
import Foreign.C (CString, castCharToCChar, CFile,
CSize, CInt, CUInt, CUChar, CChar, peekCStringLen)
+
+import Data.ByteString (ByteString, useAsCStringLen, copyCStringLen)
import System.Posix.IO (stdOutput)
import System.Posix.Types (Fd)
@@ -143,8 +145,11 @@
withUTFString s $ \str -> do
setValue t (castPtr str)
io
-withIdentifier _ _ _ i _ =
- error $ "Raptor.setIdentifier: unimplemented: " ++ show i
+withIdentifier setValue setFormat (Statement t) (Blank nodeID) io = do
+ setFormat t (cFromEnum IDENTIFIER_TYPE_ANONYMOUS)
+ withUTFString nodeID $ \str -> do
+ setValue t (castPtr str)
+ io
withSubject = withIdentifier {# set statement->subject #}
{# set statement->subject_type #}
@@ -210,8 +215,8 @@
-- | Serialize the given triples into memory
--
-triplesToString :: [Triple] -> [(String, String)] -> String -> IO String
-triplesToString triples namespaces baseURI = do
+triplesToBytes :: [Triple] -> [(String, String)] -> String -> IO ByteString
+triplesToBytes triples namespaces baseURI = do
initRaptor
serializer <- withUTFString "turtle" {# call new_serializer #}
@@ -242,7 +247,7 @@
result_str' <- fmap castPtr $ peek result_str
result_len' <- fmap fromIntegral $ peek result_len
- result <- peekCStringLen (result_str', result_len')
+ result <- copyCStringLen (result_str', result_len')
{# call free_uri #} base_uri
{# call free_memory #} (castPtr result_str')
@@ -301,13 +306,15 @@
{# call finish #}
return result
-stringToTriples :: String -> String -> IO ([Triple], [(String, String)])
-stringToTriples str baseURI = do
+bytesToTriples :: String -> ByteString -> String -> IO ([Triple], [(String, String)])
+bytesToTriples format bytes baseURI = do
initRaptor
base_uri <- withUTFString baseURI new_uri
- result <- withUTFStringLen str $ \(cstr, len) -> do
- parse (\p -> {# call parse_chunk #} p (castPtr cstr) (fromIntegral len) 1) "guess"
+ result <- useAsCStringLen bytes $ \(cstr, len) ->
+ parse (\p -> do
+ {# call start_parse #} p base_uri
+ {# call parse_chunk #} p (castPtr cstr) (fromIntegral len) 1) format
{# call free_uri #} base_uri
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs 2007-03-17 01:16:11.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs 2007-03-17 01:16:11.000000000 +0200
@@ -244,8 +244,7 @@
saveGraph :: Graph -> FilePath -> IO ()
saveGraph graph fileName = do
--writeFile fileName $ toNTriples $ reverse graph
- uri <- Raptor.filenameToURI fileName
- let (raptorTriples, namespaces) = graphToRaptor graph uri
+ let (raptorTriples, namespaces) = graphToRaptor graph
Raptor.triplesToFilename raptorTriples namespaces fileName
putStrLn $ "Saved: " ++ fileName
More information about the Fencommits
mailing list