[Fencommits] fenfire-hs: refactor RDF module: rename to Fenfire.RDF; rename URI to IRI; add support for typed literals and literals with language tags
Benja Fallenstein
benja.fallenstein at gmail.com
Wed Mar 14 15:30:54 EET 2007
Wed Mar 14 12:04:56 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* refactor RDF module: rename to Fenfire.RDF; rename URI to IRI; add support for typed literals and literals with language tags
diff -rN -u old-fenfire-hs/Data/RDF/Raptor.chs new-fenfire-hs/Data/RDF/Raptor.chs
--- old-fenfire-hs/Data/RDF/Raptor.chs 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/Data/RDF/Raptor.chs 1970-01-01 02:00:00.000000000 +0200
@@ -1,328 +0,0 @@
--- We want the C compiler to always check that types match:
-{-# OPTIONS_GHC -fvia-C #-}
-{-# OPTIONS_GHC -fffi -I. #-}
-module Data.RDF.Raptor where
-
--- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
--- This file is part of Fenfire.
---
--- Fenfire 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.
---
--- Fenfire 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 Fenfire; if not, write to the Free
--- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
--- MA 02111-1307 USA
-
-import Foreign (Ptr, FunPtr, Storable(pokeByteOff, peekByteOff), allocaBytes,
- nullPtr, castPtr, freeHaskellFunPtr)
-import Foreign.C (CString, castCharToCChar, CFile,
- CSize, CInt, CUInt, CUChar, CChar)
-
-import System.Posix.IO (stdOutput)
-import System.Posix.Types (Fd)
-import System.Environment (getArgs)
-
-import Control.Monad (when)
-import Data.IORef (IORef, modifyIORef, readIORef, newIORef)
-import Control.Exception (bracket)
-
-import System.Glib.UTFString (withUTFString, peekUTFString)
-
-#include <raptor.h>
-
--- the following three helpers are copied from C2HS.hs:
-cToEnum :: (Integral i, Enum e) => i -> e
-cToEnum = toEnum . cIntConv
-
-cFromEnum :: (Enum e, Integral i) => e -> i
-cFromEnum = cIntConv . fromEnum
-
-cIntConv :: (Integral a, Integral b) => a -> b
-cIntConv = fromIntegral
-
-
-{#context lib="raptor" prefix="raptor"#}
-
-{#enum raptor_identifier_type as IdType {} deriving (Show)#}
-
-{#enum raptor_uri_source as UriSource {} deriving (Show)#}
-
-{#pointer raptor_uri as URI newtype#}
-
-{#pointer *statement as Statement newtype#}
-
-unStatement :: Statement -> Ptr Statement
-unStatement (Statement ptr) = ptr
-
-{#pointer *raptor_namespace as Namespace newtype#}
-
-unNamespace :: Namespace -> Ptr Namespace
-unNamespace (Namespace ptr) = ptr
-
-{#pointer *raptor_locator as Locator newtype#}
-
-unLocator :: Locator -> Ptr Locator
-unLocator (Locator ptr) = ptr
-
-{#pointer *parser as Parser newtype#}
-
-unParser :: Parser -> Ptr Parser
-unParser (Parser ptr) = ptr
-
-{#pointer *serializer as Serializer newtype#}
-
-unSerializer :: Serializer -> Ptr Serializer
-unSerializer (Serializer ptr) = ptr
-
-type Triple = (Identifier, Identifier, Identifier)
-
-data Identifier = Uri String | Blank String | Literal String
- deriving (Show)
-
-mkIdentifier :: IO (Ptr ()) -> IO CInt -> IO Identifier
-mkIdentifier value format = do
- value' <- value
- format' <- format
- f (castPtr value') (cToEnum format')
- where f v IDENTIFIER_TYPE_RESOURCE = do
- cstr <- {#call uri_as_string#} (castPtr v)
- str <- peekUTFString (castPtr cstr)
- return $ Uri str
- f v IDENTIFIER_TYPE_PREDICATE = f v IDENTIFIER_TYPE_RESOURCE
- f v IDENTIFIER_TYPE_LITERAL = peekUTFString v >>= return . Literal
- f v IDENTIFIER_TYPE_ANONYMOUS = peekUTFString v >>= return . Blank
- f _ i = error $ "Raptor.mkIdentifier: Deprecated type: " ++ show i
-
-getSubject :: Statement -> IO Identifier
-getSubject (Statement s) = mkIdentifier ({#get statement->subject#} s)
- ({#get statement->subject_type#} s)
-
-getPredicate :: Statement -> IO Identifier
-getPredicate (Statement s) = mkIdentifier ({#get statement->predicate#} s)
- ({#get statement->predicate_type#} s)
-
-getObject :: Statement -> IO Identifier
-getObject (Statement s) = mkIdentifier ({#get statement->object#} s)
- ({#get statement->object_type#} s)
-
-getNamespace :: Namespace -> IO (Maybe String, Maybe String)
-getNamespace ns = do
- prefixC <- {#call raptor_namespace_get_prefix#} ns
- prefixS <- if prefixC == nullPtr
- then return Nothing
- else fmap Just $ peekUTFString (castPtr prefixC)
- uri <- {#call raptor_namespace_get_uri#} ns
- uriC <- {#call uri_as_string#} (castPtr uri)
- uriS <- if uriC == nullPtr then return Nothing
- else fmap Just $ peekUTFString (castPtr uriC)
- return (prefixS, uriS)
-
-withURI :: String -> (Ptr URI -> IO a) -> IO a
-withURI string = bracket (withUTFString string $ {# call new_uri #} . castPtr)
- {# call free_uri #}
-
-withIdentifier :: (Ptr Statement -> Ptr () -> IO ()) ->
- (Ptr Statement -> CInt -> IO ()) ->
- Statement -> Identifier -> IO a -> IO a
-withIdentifier setValue setFormat (Statement t) (Uri s) io = do
- setFormat t (cFromEnum IDENTIFIER_TYPE_RESOURCE)
- withURI s $ \uri -> do
- setValue t (castPtr uri)
- io
-withIdentifier setValue setFormat (Statement t) (Literal s) io = do
- setFormat t (cFromEnum IDENTIFIER_TYPE_LITERAL)
- withUTFString s $ \str -> do
- setValue t (castPtr str)
- io
-withIdentifier _ _ _ i _ =
- error $ "Raptor.setIdentifier: unimplemented: " ++ show i
-
-withSubject = withIdentifier {# set statement->subject #}
- {# set statement->subject_type #}
-
-withPredicate = withIdentifier {# set statement->predicate #}
- {# set statement->predicate_type #}
-
-withObject = withIdentifier {# set statement->object #}
- {# set statement->object_type #}
-
-type StatementHandler a = Ptr a -> Statement -> IO ()
-foreign import ccall "wrapper"
- mkStatementHandler :: (StatementHandler a) -> IO (FunPtr (StatementHandler a))
-
-type NamespaceHandler a = Ptr a -> Namespace -> IO ()
-foreign import ccall "wrapper"
- mkNamespaceHandler :: (NamespaceHandler a) -> IO (FunPtr (NamespaceHandler a))
-
-type MessageHandler a = Ptr a -> Locator -> CString -> IO ()
-foreign import ccall "wrapper"
- mkMessageHandler :: (MessageHandler a) -> IO (FunPtr (MessageHandler a))
-
-foreign import ccall "raptor.h raptor_init" initRaptor :: 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)
-
-foreign import ccall "raptor.h raptor_print_statement_as_ntriples" print_statement_as_ntriples :: Statement -> Ptr CFile -> IO ()
-
-foreign import ccall "stdio.h fdopen" fdopen :: Fd -> CString -> IO (Ptr CFile)
-foreign import ccall "stdio.h fputc" fputc :: CChar -> Ptr CFile -> IO ()
-
-foreign import ccall "string.h memset" c_memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
-
-
--- | Serialize the given triples into a file with the given filename
---
-triplesToFilename :: [Triple] -> [(String, String)] -> String -> IO ()
-triplesToFilename triples namespaces filename = do
- initRaptor
-
- serializer <- withUTFString "turtle" {# call new_serializer #}
- when (unSerializer serializer == nullPtr) $ fail "serializer is null"
-
- withUTFString filename $ {# call serialize_start_to_filename #} serializer
-
- flip mapM_ namespaces $ \(prefixS, uriS) -> do
- withUTFString prefixS $ \prefixC -> withUTFString 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
- flip mapM_ triples $ \(s,p,o) -> do
- c_memset ptr 0 {# sizeof statement #}
- withSubject t s $ withPredicate t p $ withObject t o $ do
- {# call serialize_statement #} serializer t
- return ()
- {# call serialize_end #} serializer
- {# call free_serializer #} serializer
- {# call finish #}
-
-filenameToURI :: String -> IO String
-filenameToURI filename = do
- uri_str <- withUTFString filename uri_filename_to_uri_string
- r <- peekUTFString uri_str
- {# call free_memory #} (castPtr uri_str)
- return r
-
--- | Parse a file with the given filename into triples
---
-filenameToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
-filenameToTriples filename baseURI = do
- let suffix = reverse $ takeWhile (/= '.') $ reverse filename
- parsertype = case suffix of "turtle" -> "turtle"
- "ttl" -> "turtle"
- "rdf" -> "rdfxml"
- "rdfxml" -> "rdfxml"
- "nt" -> "ntriples"
- _ -> "ntriples"
-
- initRaptor
-
- uri_str <- withUTFString filename uri_filename_to_uri_string
- uri <- new_uri uri_str
- base_uri <- maybe (uri_copy uri) (\s -> withUTFString s new_uri) baseURI
-
- result <- parse {# call parse_file #} parsertype uri base_uri
-
- {# call free_uri #} uri
- {# call free_uri #} base_uri
- {# call free_memory #} (castPtr uri_str)
-
- {# call finish #}
- return result
-
-uriToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
-uriToTriples uri baseURI = do
- initRaptor
-
- uri' <- withUTFString uri new_uri
- base_uri <- maybe (uri_copy uri') (\s -> withUTFString s new_uri) baseURI
-
- result <- parse {# call parse_uri #} "guess" uri' base_uri
-
- {# call free_uri #} uri'
- {# call free_uri #} base_uri
-
- {# call finish #}
- return result
-
-parse :: (Parser -> Ptr URI -> Ptr URI -> IO CInt) -> String ->
- Ptr URI -> Ptr URI -> IO ([Triple], [(String, String)])
-parse fn parsertype uri base_uri = do
- triples <- newIORef []
- namespaces <- newIORef []
-
- rdf_parser <- withUTFString parsertype {# call new_parser #}
- when (unParser rdf_parser == nullPtr) $ fail "parser is null"
-
- stHandler <- mkStatementHandler $ \_user_data triple -> do
- s <- getSubject triple
- p <- getPredicate triple
- o <- getObject triple
- modifyIORef triples ((s,p,o):)
-
- nsHandler <- mkNamespaceHandler $ \_user_data ns -> do
- (prefix, uri') <- getNamespace ns
- case (prefix, uri') of
- (Just prefix',Just uri'') -> modifyIORef namespaces ((prefix', uri''):)
- _ -> return ()
-
- let msgHandler intro = mkMessageHandler $ \_user_data locator msg -> do
- size <- {# call format_locator #} nullPtr 0 locator
- when (size > 0) $ allocaBytes (cIntConv size) $ \ptr -> do
- size' <- {# call format_locator #} ptr (cIntConv size) locator
- when (size' == 0) $ peekUTFString ptr >>= putStr
- putStr intro
- peekUTFString msg >>= putStrLn
-
- fatalHandler <- msgHandler " parser fatal error - "
- errorHandler <- msgHandler " parser error - "
- warningHandler <- msgHandler " parser warning - "
-
- {# call set_statement_handler #} rdf_parser nullPtr stHandler
- {# call set_namespace_handler #} rdf_parser nullPtr nsHandler
- {# call set_fatal_error_handler #} rdf_parser nullPtr fatalHandler
- {# call set_error_handler #} rdf_parser nullPtr errorHandler
- {# call set_warning_handler #} rdf_parser nullPtr warningHandler
-
- fn rdf_parser uri base_uri
-
- {# call free_parser #} rdf_parser
- freeHaskellFunPtr stHandler
- freeHaskellFunPtr nsHandler
- freeHaskellFunPtr fatalHandler
- freeHaskellFunPtr errorHandler
- freeHaskellFunPtr warningHandler
-
- 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 -> StatementHandler a
-print_triple outfile _user_data s = do print_statement_as_ntriples s outfile
- fputc (castCharToCChar '\n') outfile
-
-filenameToStdout :: String -> IO ()
-filenameToStdout filename = do
- outfile <- withUTFString "w" $ fdopen stdOutput
-
- initRaptor
- rdf_parser <- withUTFString "guess" {# call new_parser #}
- when (unParser rdf_parser == nullPtr) $ fail "parser is null"
- mkStatementHandler (print_triple outfile) >>= {# call set_statement_handler #} rdf_parser nullPtr
- uri <- withUTFString filename uri_filename_to_uri_string >>= new_uri
- base_uri <- uri_copy uri
- {# call parse_file #} rdf_parser uri base_uri
- return ()
diff -rN -u old-fenfire-hs/Data/RDF.hs new-fenfire-hs/Data/RDF.hs
--- old-fenfire-hs/Data/RDF.hs 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/Data/RDF.hs 1970-01-01 02:00:00.000000000 +0200
@@ -1,191 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-module Data.RDF where
-
--- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
--- This file is part of Fenfire.
---
--- Fenfire 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.
---
--- Fenfire 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 Fenfire; if not, write to the Free
--- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
--- MA 02111-1307 USA
-
-import Fenfire.Cache
-import Fenfire.Utils
-
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, isJust)
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-data Node = URI String | BNode String String | PlainLiteral String
- deriving (Eq, Ord)
-data Dir = Pos | Neg deriving (Eq, Ord, Show)
-
-instance Show Node where
- show = showNode defaultNamespaces
-
-
--- This is unfortunately something of a pun because I can't find a good
--- name for it: A 'coin' is something that has two sides...
-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
- getSide Neg = fst
- getSide Pos = snd
-
-
-type Triple = (Node, Node, Node)
-type Namespaces = Map String String
-data Graph = Graph {
- graphNamespaces :: Namespaces,
- graphSides :: Coin (Map Node (Map Node (Set Node))),
- graphRealTriples :: Set Triple } deriving (Show, Eq)
-
-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
-
-instance CoinClass Triple Node where
- getSide Neg = subject
- getSide Pos = object
-
-instance CoinClass Path Node where
- getSide Neg (Path node _) = node
- getSide Pos (Path node []) = node
- getSide Pos (Path _ conns) = connTarget (last conns)
-
-class Reversible r where
- rev :: Endo r
-
-instance Reversible Dir where
- rev Neg = Pos; rev Pos = Neg
-
-instance Reversible Path where
- 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
- hash (PlainLiteral s) = hash s
- hash (BNode g s) = hash (g,s)
-
-instance Hashable Dir where
- hash Pos = 0
- hash Neg = 1
-
-rdfs = "http://www.w3.org/2000/01/rdf-schema#"
-rdfs_label = URI "http://www.w3.org/2000/01/rdf-schema#label"
-rdfs_seeAlso = URI "http://www.w3.org/2000/01/rdf-schema#seeAlso"
-
-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
-showNode _ (BNode graph id') = "bnode[" ++ id' ++ " @ " ++ graph ++ "]"
-
-subject :: Triple -> Node
-subject (s,_,_) = s
-
-predicate :: Triple -> Node
-predicate (_,p,_) = p
-
-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)
- Map.lookup prop m
-
-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
-
-emptyGraph :: Graph
-emptyGraph = Graph defaultNamespaces (Map.empty, Map.empty) Set.empty
-
-listToGraph :: [Triple] -> Graph
-listToGraph = foldr insert emptyGraph
-
-graphToList :: Graph -> [Triple]
-graphToList = Set.toAscList . graphRealTriples
-
-mergeGraphs :: Op Graph
-mergeGraphs real virtual = foldr insertVirtual real (graphToList virtual)
-
-insert :: Triple -> Endo Graph
-insert t graph@(Graph { graphRealTriples=ts }) =
- insertVirtual t $ graph { graphRealTriples = Set.insert t ts }
-
-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 (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 -> 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 -> Endo Graph
-update (s,p,o) g = insert (s,p,o) $ deleteAll s p g
-
-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
-
-addNamespace :: String -> String -> Endo Graph
-addNamespace prefix uri g =
- g { graphNamespaces = Map.insert prefix uri $ graphNamespaces g }
-
-triple :: Dir -> (Node,Node,Node) -> Triple
-triple Pos (s,p,o) = (s,p,o)
-triple Neg (o,p,s) = (s,p,o)
-
-mul :: Num a => Dir -> a -> a
-mul Pos = id
-mul Neg = negate
diff -rN -u old-fenfire-hs/Fenfire/Main.hs new-fenfire-hs/Fenfire/Main.hs
--- old-fenfire-hs/Fenfire/Main.hs 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/Fenfire/Main.hs 2007-03-14 15:30:54.000000000 +0200
@@ -21,9 +21,9 @@
import Fenfire.Utils
import Fenfire.Cairo hiding (Path, rotate)
import Fenfire.Vobs
-import qualified Data.RDF.Raptor as Raptor
+import qualified Fenfire.Raptor as Raptor
import Fenfire.URN5
-import Data.RDF
+import Fenfire.RDF
import Fenfire.VanishingView
import Fenfire
@@ -57,12 +57,12 @@
interpretNode :: (?graph :: Graph) => String -> Node
interpretNode str | "<" `List.isPrefixOf` str && ">" `List.isSuffixOf` str =
- URI $ tail $ init str
+ IRI $ tail $ init str
| isQname
, Just base <- Map.lookup ns (graphNamespaces ?graph) =
- URI $ base ++ local
+ IRI $ base ++ local
| isQname = error $ "No such namespace: \""++ns++"\""
- | otherwise = URI str
+ | otherwise = IRI str
where local = drop 1 $ dropWhile (/= ':') str
ns = takeWhile (/= ':') str
isQname = ns /= "" && (not $ any (`elem` local) [':', '/', '@'])
@@ -208,14 +208,14 @@
"open" -> confirmSave modified $ do
result <- liftIO $ openFile filepath
maybeDo result $ \(g',fp') -> do
- uri <- liftM URI $ liftIO $ Raptor.filenameToURI fp'
+ uri <- liftM IRI $ liftIO $ Raptor.filenameToURI fp'
let ts = containsInfoTriples uri g'
g'' = foldr insertVirtual g' ts
put $ newState g'' (findStartPath uri g'') fp' focus
- "loadURI" -> case node of
- URI uri -> do
+ "loadIRI" -> case node of
+ IRI uri -> do
g <- liftIO $ loadGraph uri
- let ts = containsInfoTriples (URI uri) g
+ let ts = containsInfoTriples (IRI uri) g
g' = foldr insertVirtual
(mergeGraphs graph g) ts
s' = state {fsGraph=g',
@@ -225,7 +225,7 @@
_ -> unhandledEvent
"revert" | filepath /= "" -> confirmRevert modified $ do
g' <- liftIO $ loadGraph filepath
- gNode <- liftM URI $ liftIO $ Raptor.filenameToURI filepath
+ gNode <- liftM IRI $ liftIO $ Raptor.filenameToURI filepath
let g'' = foldr insertVirtual g' $ containsInfoTriples gNode g'
put $ newState g'' (findStartPath gNode g'') filepath focus
"save" | filepath /= "" -> do
@@ -241,7 +241,7 @@
"chgview" -> do put $ state { fsView = (fsView state + 1) `mod`
(length ?views) }
setInterp True
- "addprop" -> do let uri = case node of URI _ -> showNode
+ "addprop" -> do let uri = case node of IRI _ -> showNode
(graphNamespaces graph) node
_ -> ""
confirmString "Add property" uri $ \uri' ->
@@ -252,8 +252,8 @@
fsProperties = Set.insert prop' props }
"resetprop" -> when (fsProperty state /= rdfs_seeAlso) $
put $ state { fsProperty = rdfs_seeAlso }
- "changeURI" -> case node of
- URI _ -> confirmString "New URI" (showNode
+ "changeIRI" -> case node of
+ IRI _ -> confirmString "New IRI" (showNode
(graphNamespaces graph) node) $ \uri' ->
put $ stateReplaceNode node
(interpretNode uri') state
@@ -290,7 +290,7 @@
, ( "revert" , Nothing, stockRevertToSaved , Nothing )
, ( "quit" , Nothing, stockQuit , Nothing )
, ( "about" , Nothing, stockAbout , Nothing )
- , ( "loadURI", Just "_Load node's URI",
+ , ( "loadIRI", Just "_Load node's IRI",
stockGoForward , Just "<Ctl>L" )
, ( "undo" , Nothing, stockUndo , Just "<Ctl>Z" )
, ( "redo" , Nothing, stockRedo , Just "<Ctl><Shift>Z" )
@@ -324,7 +324,7 @@
menu <- menuNew
forM (Set.toAscList $ fsProperties state) $ \prop -> do
item <- let ?graph = fsGraph state
- in menuItemNewWithLabel $ getTextOrURI prop
+ in menuItemNewWithLabel $ getTextOrIRI prop
onActivateLeaf item $ do
modifyIORef stateRef $ \state' -> state' {fsProperty=prop}
updateCanvas False
@@ -358,7 +358,7 @@
stockStrikethrough , Just "<Alt>BackSpace" )
, ("addprop", Just "_Add property" ,
stockAdd , Just "<Ctl>P" )
- , ("changeURI", Just "Change node's _URI" ,
+ , ("changeIRI", Just "Change node's _IRI" ,
stockRefresh , Just "u" )
]
forM bindingentries $ \(name,label',stock,accel) -> do
@@ -367,7 +367,7 @@
actionSetAccelGroup action bindings
makeMenus actionGroup root propmenu = addAll root menu where
- menu = [m "_File" [a "new", a "open", a "loadURI", sep,
+ menu = [m "_File" [a "new", a "open", a "loadIRI", sep,
a "save", a "saveas", a "revert", sep,
a "quit"],
m "_Edit" [a "undo", a "redo", sep,
@@ -375,7 +375,7 @@
a "noder", a "nodel", sep,
a "breakr", a "breakl", sep,
a "mark", a "connr", a "connl", sep,
- a "changeURI", a "rmlit"],
+ a "changeIRI", a "rmlit"],
m "_View" (map (a . fst) ?views),
m "_Help" [a "about"]]
addAll parent items = mapM_ (menuShellAppend parent) =<< sequence items
@@ -454,9 +454,9 @@
uri <- Raptor.filenameToURI fileName
uris <- mapM Raptor.filenameToURI fileNames
let ts = concatMap (uncurry containsInfoTriples) $
- (URI uri, g') : zip (map URI uris) gs
+ (IRI uri, g') : zip (map IRI uris) gs
graph = foldr insertVirtual (foldl mergeGraphs g' gs) ts
- newIORef $ newState graph (findStartPath (URI uri) graph) fileName False
+ newIORef $ newState graph (findStartPath (IRI uri) graph) fileName False
-- start:
@@ -504,7 +504,7 @@
New.listStoreClear propList
forM_ (Set.toAscList $ fsProperties state) $ \prop ->
let ?graph = g in
- New.listStoreAppend propList (prop, getTextOrURI prop)
+ New.listStoreAppend propList (prop, getTextOrIRI prop)
let activeIndex = List.elemIndex (fsProperty state)
(Set.toAscList $ fsProperties state)
maybe (return ()) (New.comboBoxSetActive combo) activeIndex
diff -rN -u old-fenfire-hs/Fenfire/RDF.hs new-fenfire-hs/Fenfire/RDF.hs
--- old-fenfire-hs/Fenfire/RDF.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenfire-hs/Fenfire/RDF.hs 2007-03-14 15:30:54.000000000 +0200
@@ -0,0 +1,199 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Fenfire.RDF where
+
+-- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
+-- This file is part of Fenfire.
+--
+-- Fenfire 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.
+--
+-- Fenfire 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 Fenfire; if not, write to the Free
+-- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+-- MA 02111-1307 USA
+
+import Fenfire.Cache
+import Fenfire.Utils
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe, isJust)
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+
+data Node = IRI { nodeStr :: String }
+ | BNode { bnodeGraph :: String, nodeStr :: String }
+ | Literal { nodeStr :: String, literalTag :: LiteralTag }
+ deriving (Eq, Ord)
+data LiteralTag = Plain | Lang String | Type String deriving (Eq, Ord, Show)
+data Dir = Pos | Neg deriving (Eq, Ord, Show)
+
+instance Show Node where
+ show = showNode defaultNamespaces
+
+
+-- This is unfortunately something of a pun because I can't find a good
+-- name for it: A 'coin' is something that has two sides...
+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
+ getSide Neg = fst
+ getSide Pos = snd
+
+
+type Triple = (Node, Node, Node)
+type Namespaces = Map String String
+data Graph = Graph {
+ graphNamespaces :: Namespaces,
+ graphSides :: Coin (Map Node (Map Node (Set Node))),
+ graphRealTriples :: Set Triple } deriving (Show, Eq)
+
+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
+
+instance CoinClass Triple Node where
+ getSide Neg = subject
+ getSide Pos = object
+
+instance CoinClass Path Node where
+ getSide Neg (Path node _) = node
+ getSide Pos (Path node []) = node
+ getSide Pos (Path _ conns) = connTarget (last conns)
+
+class Reversible r where
+ rev :: Endo r
+
+instance Reversible Dir where
+ rev Neg = Pos; rev Pos = Neg
+
+instance Reversible Path where
+ 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 (IRI s) = hash s
+ hash (BNode g s) = hash (g,s)
+ hash (Literal s Plain) = hash s
+ hash (Literal s (Lang l)) = hash (s,l)
+ hash (Literal s (Type t)) = hash (s,t)
+
+instance Hashable Dir where
+ hash Pos = 0
+ hash Neg = 1
+
+rdfs = "http://www.w3.org/2000/01/rdf-schema#"
+rdfs_label = IRI "http://www.w3.org/2000/01/rdf-schema#label"
+rdfs_seeAlso = IRI "http://www.w3.org/2000/01/rdf-schema#seeAlso"
+
+defaultNamespaces = Map.fromList [("rdfs", rdfs)]
+
+showNode :: Namespaces -> Node -> String
+showNode ns (IRI 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 _ (BNode graph id') = "bnode[" ++ id' ++ " @ " ++ graph ++ "]"
+showNode _ (Literal lit Plain) = show lit
+showNode _ (Literal lit (Lang lang)) = show lit ++ "@" ++ lang
+showNode _ (Literal lit (Type type')) = show lit ++ "^^<" ++ type' ++ ">"
+
+subject :: Triple -> Node
+subject (s,_,_) = s
+
+predicate :: Triple -> Node
+predicate (_,p,_) = p
+
+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)
+ Map.lookup prop m
+
+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
+
+emptyGraph :: Graph
+emptyGraph = Graph defaultNamespaces (Map.empty, Map.empty) Set.empty
+
+listToGraph :: [Triple] -> Graph
+listToGraph = foldr insert emptyGraph
+
+graphToList :: Graph -> [Triple]
+graphToList = Set.toAscList . graphRealTriples
+
+mergeGraphs :: Op Graph
+mergeGraphs real virtual = foldr insertVirtual real (graphToList virtual)
+
+insert :: Triple -> Endo Graph
+insert t graph@(Graph { graphRealTriples=ts }) =
+ insertVirtual t $ graph { graphRealTriples = Set.insert t ts }
+
+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 (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 -> 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 -> Endo Graph
+update (s,p,o) g = insert (s,p,o) $ deleteAll s p g
+
+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
+
+addNamespace :: String -> String -> Endo Graph
+addNamespace prefix uri g =
+ g { graphNamespaces = Map.insert prefix uri $ graphNamespaces g }
+
+triple :: Dir -> (Node,Node,Node) -> Triple
+triple Pos (s,p,o) = (s,p,o)
+triple Neg (o,p,s) = (s,p,o)
+
+mul :: Num a => Dir -> a -> a
+mul Pos = id
+mul Neg = negate
diff -rN -u old-fenfire-hs/Fenfire/Raptor.chs new-fenfire-hs/Fenfire/Raptor.chs
--- old-fenfire-hs/Fenfire/Raptor.chs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenfire-hs/Fenfire/Raptor.chs 2007-03-14 15:30:54.000000000 +0200
@@ -0,0 +1,328 @@
+-- We want the C compiler to always check that types match:
+{-# OPTIONS_GHC -fvia-C #-}
+{-# OPTIONS_GHC -fffi -I. #-}
+module Fenfire.Raptor where
+
+-- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
+-- This file is part of Fenfire.
+--
+-- Fenfire 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.
+--
+-- Fenfire 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 Fenfire; if not, write to the Free
+-- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+-- MA 02111-1307 USA
+
+import Foreign (Ptr, FunPtr, Storable(pokeByteOff, peekByteOff), allocaBytes,
+ nullPtr, castPtr, freeHaskellFunPtr)
+import Foreign.C (CString, castCharToCChar, CFile,
+ CSize, CInt, CUInt, CUChar, CChar)
+
+import System.Posix.IO (stdOutput)
+import System.Posix.Types (Fd)
+import System.Environment (getArgs)
+
+import Control.Monad (when)
+import Data.IORef (IORef, modifyIORef, readIORef, newIORef)
+import Control.Exception (bracket)
+
+import System.Glib.UTFString (withUTFString, peekUTFString)
+
+#include <raptor.h>
+
+-- the following three helpers are copied from C2HS.hs:
+cToEnum :: (Integral i, Enum e) => i -> e
+cToEnum = toEnum . cIntConv
+
+cFromEnum :: (Enum e, Integral i) => e -> i
+cFromEnum = cIntConv . fromEnum
+
+cIntConv :: (Integral a, Integral b) => a -> b
+cIntConv = fromIntegral
+
+
+{#context lib="raptor" prefix="raptor"#}
+
+{#enum raptor_identifier_type as IdType {} deriving (Show)#}
+
+{#enum raptor_uri_source as UriSource {} deriving (Show)#}
+
+{#pointer raptor_uri as URI newtype#}
+
+{#pointer *statement as Statement newtype#}
+
+unStatement :: Statement -> Ptr Statement
+unStatement (Statement ptr) = ptr
+
+{#pointer *raptor_namespace as Namespace newtype#}
+
+unNamespace :: Namespace -> Ptr Namespace
+unNamespace (Namespace ptr) = ptr
+
+{#pointer *raptor_locator as Locator newtype#}
+
+unLocator :: Locator -> Ptr Locator
+unLocator (Locator ptr) = ptr
+
+{#pointer *parser as Parser newtype#}
+
+unParser :: Parser -> Ptr Parser
+unParser (Parser ptr) = ptr
+
+{#pointer *serializer as Serializer newtype#}
+
+unSerializer :: Serializer -> Ptr Serializer
+unSerializer (Serializer ptr) = ptr
+
+type Triple = (Identifier, Identifier, Identifier)
+
+data Identifier = Uri String | Blank String | Literal String
+ deriving (Show)
+
+mkIdentifier :: IO (Ptr ()) -> IO CInt -> IO Identifier
+mkIdentifier value format = do
+ value' <- value
+ format' <- format
+ f (castPtr value') (cToEnum format')
+ where f v IDENTIFIER_TYPE_RESOURCE = do
+ cstr <- {#call uri_as_string#} (castPtr v)
+ str <- peekUTFString (castPtr cstr)
+ return $ Uri str
+ f v IDENTIFIER_TYPE_PREDICATE = f v IDENTIFIER_TYPE_RESOURCE
+ f v IDENTIFIER_TYPE_LITERAL = peekUTFString v >>= return . Literal
+ f v IDENTIFIER_TYPE_ANONYMOUS = peekUTFString v >>= return . Blank
+ f _ i = error $ "Raptor.mkIdentifier: Deprecated type: " ++ show i
+
+getSubject :: Statement -> IO Identifier
+getSubject (Statement s) = mkIdentifier ({#get statement->subject#} s)
+ ({#get statement->subject_type#} s)
+
+getPredicate :: Statement -> IO Identifier
+getPredicate (Statement s) = mkIdentifier ({#get statement->predicate#} s)
+ ({#get statement->predicate_type#} s)
+
+getObject :: Statement -> IO Identifier
+getObject (Statement s) = mkIdentifier ({#get statement->object#} s)
+ ({#get statement->object_type#} s)
+
+getNamespace :: Namespace -> IO (Maybe String, Maybe String)
+getNamespace ns = do
+ prefixC <- {#call raptor_namespace_get_prefix#} ns
+ prefixS <- if prefixC == nullPtr
+ then return Nothing
+ else fmap Just $ peekUTFString (castPtr prefixC)
+ uri <- {#call raptor_namespace_get_uri#} ns
+ uriC <- {#call uri_as_string#} (castPtr uri)
+ uriS <- if uriC == nullPtr then return Nothing
+ else fmap Just $ peekUTFString (castPtr uriC)
+ return (prefixS, uriS)
+
+withURI :: String -> (Ptr URI -> IO a) -> IO a
+withURI string = bracket (withUTFString string $ {# call new_uri #} . castPtr)
+ {# call free_uri #}
+
+withIdentifier :: (Ptr Statement -> Ptr () -> IO ()) ->
+ (Ptr Statement -> CInt -> IO ()) ->
+ Statement -> Identifier -> IO a -> IO a
+withIdentifier setValue setFormat (Statement t) (Uri s) io = do
+ setFormat t (cFromEnum IDENTIFIER_TYPE_RESOURCE)
+ withURI s $ \uri -> do
+ setValue t (castPtr uri)
+ io
+withIdentifier setValue setFormat (Statement t) (Literal s) io = do
+ setFormat t (cFromEnum IDENTIFIER_TYPE_LITERAL)
+ withUTFString s $ \str -> do
+ setValue t (castPtr str)
+ io
+withIdentifier _ _ _ i _ =
+ error $ "Raptor.setIdentifier: unimplemented: " ++ show i
+
+withSubject = withIdentifier {# set statement->subject #}
+ {# set statement->subject_type #}
+
+withPredicate = withIdentifier {# set statement->predicate #}
+ {# set statement->predicate_type #}
+
+withObject = withIdentifier {# set statement->object #}
+ {# set statement->object_type #}
+
+type StatementHandler a = Ptr a -> Statement -> IO ()
+foreign import ccall "wrapper"
+ mkStatementHandler :: (StatementHandler a) -> IO (FunPtr (StatementHandler a))
+
+type NamespaceHandler a = Ptr a -> Namespace -> IO ()
+foreign import ccall "wrapper"
+ mkNamespaceHandler :: (NamespaceHandler a) -> IO (FunPtr (NamespaceHandler a))
+
+type MessageHandler a = Ptr a -> Locator -> CString -> IO ()
+foreign import ccall "wrapper"
+ mkMessageHandler :: (MessageHandler a) -> IO (FunPtr (MessageHandler a))
+
+foreign import ccall "raptor.h raptor_init" initRaptor :: 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)
+
+foreign import ccall "raptor.h raptor_print_statement_as_ntriples" print_statement_as_ntriples :: Statement -> Ptr CFile -> IO ()
+
+foreign import ccall "stdio.h fdopen" fdopen :: Fd -> CString -> IO (Ptr CFile)
+foreign import ccall "stdio.h fputc" fputc :: CChar -> Ptr CFile -> IO ()
+
+foreign import ccall "string.h memset" c_memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
+
+
+-- | Serialize the given triples into a file with the given filename
+--
+triplesToFilename :: [Triple] -> [(String, String)] -> String -> IO ()
+triplesToFilename triples namespaces filename = do
+ initRaptor
+
+ serializer <- withUTFString "turtle" {# call new_serializer #}
+ when (unSerializer serializer == nullPtr) $ fail "serializer is null"
+
+ withUTFString filename $ {# call serialize_start_to_filename #} serializer
+
+ flip mapM_ namespaces $ \(prefixS, uriS) -> do
+ withUTFString prefixS $ \prefixC -> withUTFString 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
+ flip mapM_ triples $ \(s,p,o) -> do
+ c_memset ptr 0 {# sizeof statement #}
+ withSubject t s $ withPredicate t p $ withObject t o $ do
+ {# call serialize_statement #} serializer t
+ return ()
+ {# call serialize_end #} serializer
+ {# call free_serializer #} serializer
+ {# call finish #}
+
+filenameToURI :: String -> IO String
+filenameToURI filename = do
+ uri_str <- withUTFString filename uri_filename_to_uri_string
+ r <- peekUTFString uri_str
+ {# call free_memory #} (castPtr uri_str)
+ return r
+
+-- | Parse a file with the given filename into triples
+--
+filenameToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
+filenameToTriples filename baseURI = do
+ let suffix = reverse $ takeWhile (/= '.') $ reverse filename
+ parsertype = case suffix of "turtle" -> "turtle"
+ "ttl" -> "turtle"
+ "rdf" -> "rdfxml"
+ "rdfxml" -> "rdfxml"
+ "nt" -> "ntriples"
+ _ -> "ntriples"
+
+ initRaptor
+
+ uri_str <- withUTFString filename uri_filename_to_uri_string
+ uri <- new_uri uri_str
+ base_uri <- maybe (uri_copy uri) (\s -> withUTFString s new_uri) baseURI
+
+ result <- parse {# call parse_file #} parsertype uri base_uri
+
+ {# call free_uri #} uri
+ {# call free_uri #} base_uri
+ {# call free_memory #} (castPtr uri_str)
+
+ {# call finish #}
+ return result
+
+uriToTriples :: String -> Maybe String -> IO ([Triple], [(String, String)])
+uriToTriples uri baseURI = do
+ initRaptor
+
+ uri' <- withUTFString uri new_uri
+ base_uri <- maybe (uri_copy uri') (\s -> withUTFString s new_uri) baseURI
+
+ result <- parse {# call parse_uri #} "guess" uri' base_uri
+
+ {# call free_uri #} uri'
+ {# call free_uri #} base_uri
+
+ {# call finish #}
+ return result
+
+parse :: (Parser -> Ptr URI -> Ptr URI -> IO CInt) -> String ->
+ Ptr URI -> Ptr URI -> IO ([Triple], [(String, String)])
+parse fn parsertype uri base_uri = do
+ triples <- newIORef []
+ namespaces <- newIORef []
+
+ rdf_parser <- withUTFString parsertype {# call new_parser #}
+ when (unParser rdf_parser == nullPtr) $ fail "parser is null"
+
+ stHandler <- mkStatementHandler $ \_user_data triple -> do
+ s <- getSubject triple
+ p <- getPredicate triple
+ o <- getObject triple
+ modifyIORef triples ((s,p,o):)
+
+ nsHandler <- mkNamespaceHandler $ \_user_data ns -> do
+ (prefix, uri') <- getNamespace ns
+ case (prefix, uri') of
+ (Just prefix',Just uri'') -> modifyIORef namespaces ((prefix', uri''):)
+ _ -> return ()
+
+ let msgHandler intro = mkMessageHandler $ \_user_data locator msg -> do
+ size <- {# call format_locator #} nullPtr 0 locator
+ when (size > 0) $ allocaBytes (cIntConv size) $ \ptr -> do
+ size' <- {# call format_locator #} ptr (cIntConv size) locator
+ when (size' == 0) $ peekUTFString ptr >>= putStr
+ putStr intro
+ peekUTFString msg >>= putStrLn
+
+ fatalHandler <- msgHandler " parser fatal error - "
+ errorHandler <- msgHandler " parser error - "
+ warningHandler <- msgHandler " parser warning - "
+
+ {# call set_statement_handler #} rdf_parser nullPtr stHandler
+ {# call set_namespace_handler #} rdf_parser nullPtr nsHandler
+ {# call set_fatal_error_handler #} rdf_parser nullPtr fatalHandler
+ {# call set_error_handler #} rdf_parser nullPtr errorHandler
+ {# call set_warning_handler #} rdf_parser nullPtr warningHandler
+
+ fn rdf_parser uri base_uri
+
+ {# call free_parser #} rdf_parser
+ freeHaskellFunPtr stHandler
+ freeHaskellFunPtr nsHandler
+ freeHaskellFunPtr fatalHandler
+ freeHaskellFunPtr errorHandler
+ freeHaskellFunPtr warningHandler
+
+ 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 -> StatementHandler a
+print_triple outfile _user_data s = do print_statement_as_ntriples s outfile
+ fputc (castCharToCChar '\n') outfile
+
+filenameToStdout :: String -> IO ()
+filenameToStdout filename = do
+ outfile <- withUTFString "w" $ fdopen stdOutput
+
+ initRaptor
+ rdf_parser <- withUTFString "guess" {# call new_parser #}
+ when (unParser rdf_parser == nullPtr) $ fail "parser is null"
+ mkStatementHandler (print_triple outfile) >>= {# call set_statement_handler #} rdf_parser nullPtr
+ uri <- withUTFString filename uri_filename_to_uri_string >>= new_uri
+ base_uri <- uri_copy uri
+ {# call parse_file #} rdf_parser uri base_uri
+ return ()
diff -rN -u old-fenfire-hs/Fenfire/VanishingView.fhs new-fenfire-hs/Fenfire/VanishingView.fhs
--- old-fenfire-hs/Fenfire/VanishingView.fhs 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/Fenfire/VanishingView.fhs 2007-03-14 15:30:54.000000000 +0200
@@ -21,7 +21,7 @@
import Fenfire.Utils
import Fenfire.Cairo hiding (Path, rotate)
import Fenfire.Vobs
-import Data.RDF
+import Fenfire.RDF
import Fenfire
import Control.Monad
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs 2007-03-14 15:30:54.000000000 +0200
@@ -23,9 +23,9 @@
import Fenfire.Cairo hiding (rotate, Path)
import Fenfire.Vobs
import Fenfire.Utils
-import qualified Data.RDF.Raptor as Raptor
+import qualified Fenfire.Raptor as Raptor
import Fenfire.URN5
-import Data.RDF
+import Fenfire.RDF
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -76,8 +76,8 @@
connsCache :: Cache.Cache (StableName Graph, (Node, Dir)) [Path]
connsCache = Cache.newCache 10000
-dc_date = URI "http://purl.org/dc/elements/1.1/date"
-dcterms_created = URI "http://purl.org/dc/terms/created"
+dc_date = IRI "http://purl.org/dc/elements/1.1/date"
+dcterms_created = IRI "http://purl.org/dc/terms/created"
conns :: (?vs :: ViewSettings, ?graph :: Graph) => Node -> Dir -> [Path]
conns node dir = Cache.cached (Cache.byAddress ?graph, (node,dir))
@@ -105,23 +105,22 @@
return $ fromPath (rev path)
getText :: (?graph :: Graph) => Node -> Maybe String
-getText n = fmap f $ getOne ?graph n rdfs_label Pos where
- f (PlainLiteral s) = s; f _ = error "getText argh"
+getText n = fmap nodeStr $ getOne ?graph n rdfs_label Pos
-getTextOrURI :: (?graph :: Graph) => Node -> String
-getTextOrURI n = fromMaybe (showNode (graphNamespaces ?graph) n) (getText n)
+getTextOrIRI :: (?graph :: Graph) => Node -> String
+getTextOrIRI n = fromMaybe (showNode (graphNamespaces ?graph) n) (getText n)
setText :: Node -> String -> Endo Graph
-setText n t = update (n, rdfs_label, PlainLiteral t)
+setText n t = update (n, rdfs_label, Literal t Plain)
nodeView :: (?graph :: Graph) => Node -> Vob Node
-nodeView n = useFgColor $ case getTextOrURI n of
+nodeView n = useFgColor $ case getTextOrIRI n of
'T':'e':'X':':':s -> latex s
s -> multiline False 20 s
propView :: (?graph :: Graph) => Node -> Vob Node
propView n = (useFadeColor $ fill extents)
- & (pad 5 $ useFgColor $ label $ getTextOrURI n)
+ & (pad 5 $ useFgColor $ label $ getTextOrIRI n)
@@ -133,9 +132,9 @@
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
+ multiline True 70 $ getTextOrIRI n
cursor = flip (maybe mempty) selected $ \n ->
- showAtKey n $ keyVob (PlainLiteral "CURSOR") $ rectBox mempty
+ showAtKey n $ keyVob (Literal "CURSOR" Plain) $ rectBox mempty
space = changeSize (const (0, 20)) mempty
vob = pad 30 $ vbox $ List.intersperse space $ f 3 node : map (f 2) children
@@ -159,9 +158,9 @@
Dir -> EndoM IO FenState
newNode dir state@(FenState { fsGraph = graph, fsProperty = prop,
fsPath = Path node _ }) = do
- node' <- liftM URI newURI
+ node' <- liftM IRI newURI
let graph' = insert (triple dir (node, prop, node'))
- $ insert (node', rdfs_label, PlainLiteral "") graph
+ $ insert (node', rdfs_label, Literal "" Plain) graph
in return $ modifyGraph graph' (Path node' [Conn prop (rev dir) node]) state
connect :: (?vs :: ViewSettings) => Dir -> Endo FenState
@@ -195,8 +194,8 @@
newGraph :: (?uriMaker :: URIMaker) => IO (Graph, Path)
newGraph = do
- home <- liftM URI newURI
- let graph = listToGraph [(home, rdfs_label, PlainLiteral "")]
+ home <- liftM IRI newURI
+ let graph = listToGraph [(home, rdfs_label, Literal "" Plain)]
return (graph, Path home [])
findStartPath :: (?vs :: ViewSettings) => Node -> Graph -> Path
@@ -212,12 +211,12 @@
getRot (s,p,o) = Path s [Conn p Pos o]
getRot' (s,p,o) = 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"
+ 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) => Node -> Graph -> [Triple]
containsInfoTriples s g = [(s, p, o) | o <- os, o /= s] where
- p = URI "ex:containsInformationAbout"
+ p = IRI "ex:containsInformationAbout"
triples = graphToList g
[subjects, objects] = for [subject, object] $ \f -> map f triples
os = Set.toAscList $ foldr Set.delete (Set.fromList subjects) objects
@@ -227,8 +226,8 @@
--file <- readFile fileName
--graph <- fromNTriples file >>= return . reverse-}
let convert (s,p,o) = (f s, f p, f o)
- f (Raptor.Uri s) = URI s
- f (Raptor.Literal s) = PlainLiteral s
+ f (Raptor.Uri s) = IRI s
+ f (Raptor.Literal s) = Literal s Plain
f (Raptor.Blank s) = BNode fileName s
(raptorTriples, namespaces) <- if List.isPrefixOf "http:" fileName
then Raptor.uriToTriples fileName Nothing
@@ -242,10 +241,10 @@
uri <- liftM (fromJust . Network.URI.parseURI)
(Raptor.filenameToURI fileName)
let convert (s,p,o) = (f s, f p, f o)
- f (URI s) = Raptor.Uri $ fromMaybe s $ do
+ f (IRI s) = Raptor.Uri $ fromMaybe s $ do
u <- Network.URI.parseURI s
return $ show $ Network.URI.relativeFrom u uri
- f (PlainLiteral s) = Raptor.Literal s
+ f (Literal s _) = Raptor.Literal s
f (BNode g s) = if g == fileName then Raptor.Blank s
else error "XXX Cannot save bnode from different graph"
triples = graphToList graph
@@ -258,7 +257,7 @@
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 (_, _, URI _) = True
+ f (_, _, IRI _) = True
f _ = False
stateReplaceNode :: Node -> Node -> Endo FenState
diff -rN -u old-fenfire-hs/fenfire.cabal new-fenfire-hs/fenfire.cabal
--- old-fenfire-hs/fenfire.cabal 2007-03-14 15:30:54.000000000 +0200
+++ new-fenfire-hs/fenfire.cabal 2007-03-14 15:30:54.000000000 +0200
@@ -13,12 +13,12 @@
Homepage: http://fenfire.org/
Build-Depends: base, HaXml, gtk > 0.9.10, mtl, unix, cairo, harp,
template-haskell, glib, network
-Exposed-Modules: Data.RDF, Data.RDF.Raptor
+Exposed-Modules: Fenfire.RDF, Fenfire.Raptor, Fenfire.Utils, Fenfire.Cache
Data-Files: data-files/logo.svg data-files/icon16.png
Executable: fenfire
Main-Is: Fenfire/Main.hs
-Other-Modules: Fenfire, Fenfire.Vobs, Data.RDF, Fenfire.Cache, Fenfire.Cairo, Fenfire.Utils, Data.RDF.Raptor, FunctorSugar,
+Other-Modules: Fenfire, Fenfire.Vobs, Fenfire.RDF, Fenfire.Cache, Fenfire.Cairo, Fenfire.Utils, Fenfire.Raptor, FunctorSugar,
Fenfire.GtkFixes, Fenfire.VanishingView, Fenfire.Main
GHC-Options: -fglasgow-exts -hide-package haskell98 -Wall
-fno-warn-unused-imports -fno-warn-missing-signatures
More information about the Fencommits
mailing list