[Fencommits] fenfire-hs: move RDF to Data.RDF. now Raptor isn't preprocessed correctly any more for some unknown reason
Benja Fallenstein
benja.fallenstein at gmail.com
Sun Mar 11 15:52:00 EET 2007
Sun Mar 11 14:33:17 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* move RDF to Data.RDF. now Raptor isn't preprocessed correctly any more for some unknown reason
diff -rN -u old-fenfire-hs/Cache.hs new-fenfire-hs/Cache.hs
--- old-fenfire-hs/Cache.hs 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/Cache.hs 2007-03-11 15:52:00.000000000 +0200
@@ -1,5 +1,25 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
module Cache where
+-- Copyright (c) 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 Utils
import Data.Bits
Binary files old-fenfire-hs/data/icon16.png and new-fenfire-hs/data/icon16.png differ
diff -rN -u old-fenfire-hs/data/logo.svg new-fenfire-hs/data/logo.svg
--- old-fenfire-hs/data/logo.svg 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/data/logo.svg 1970-01-01 02:00:00.000000000 +0200
@@ -1,21 +0,0 @@
-<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
-<svg width="506.441" height="709.024">
- <defs>
- <marker id="ArrowEnd" viewBox="0 0 10 10" refX="0" refY="5"
- markerUnits="strokeWidth"
- markerWidth="4"
- markerHeight="3"
- orient="auto">
- <path d="M 0 0 L 10 5 L 0 10 z" />
- </marker>
- <marker id="ArrowStart" viewBox="0 0 10 10" refX="10" refY="5"
- markerUnits="strokeWidth"
- markerWidth="4"
- markerHeight="3"
- orient="auto">
- <path d="M 10 0 L 0 5 L 10 10 z" />
- </marker> </defs>
-<g>
-<path style="stroke:#5a5176; stroke-width:18.0; fill:#bdbaff" d="M 253.328 614.689C 182.584 613.866 95.1702 558.196 94.3352 471.647C 103.523 416.226 131.382 420.319 133.052 371.727C 133.052 371.727 164.792 424.115 172.31 470.429C 153.098 352.745 189.015 373.244 175.65 280.615C 175.65 280.615 212.928 323.852 222.115 398.259C 198.729 228.946 233.322 288.245 253.293 94.3352C 268.094 288.148 307.712 228.023 284.324 397.903C 293.512 323.248 330.79 279.866 330.79 279.866C 317.427 372.806 353.34 352.237 334.132 470.315C 341.649 423.845 373.387 371.281 373.387 371.281C 375.058 420.037 402.918 415.93 412.106 471.537C 411.271 558.375 324.071 613.864 253.328 614.689z"/>
-</g>
-</svg>
\ No newline at end of file
diff -rN -u old-fenfire-hs/Data/RDF/Raptor.chs new-fenfire-hs/Data/RDF/Raptor.chs
--- old-fenfire-hs/Data/RDF/Raptor.chs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenfire-hs/Data/RDF/Raptor.chs 2007-03-11 15:52:00.000000000 +0200
@@ -0,0 +1,327 @@
+-- We want the C compiler to always check that types match:
+{-# OPTIONS_GHC -fvia-C #-}
+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 1970-01-01 02:00:00.000000000 +0200
+++ new-fenfire-hs/Data/RDF.hs 2007-03-11 15:52:00.000000000 +0200
@@ -0,0 +1,190 @@
+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 Cache
+import 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
Binary files old-fenfire-hs/data-files/icon16.png and new-fenfire-hs/data-files/icon16.png differ
diff -rN -u old-fenfire-hs/data-files/logo.svg new-fenfire-hs/data-files/logo.svg
--- old-fenfire-hs/data-files/logo.svg 1970-01-01 02:00:00.000000000 +0200
+++ new-fenfire-hs/data-files/logo.svg 2007-03-11 15:52:00.000000000 +0200
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
+<svg width="506.441" height="709.024">
+ <defs>
+ <marker id="ArrowEnd" viewBox="0 0 10 10" refX="0" refY="5"
+ markerUnits="strokeWidth"
+ markerWidth="4"
+ markerHeight="3"
+ orient="auto">
+ <path d="M 0 0 L 10 5 L 0 10 z" />
+ </marker>
+ <marker id="ArrowStart" viewBox="0 0 10 10" refX="10" refY="5"
+ markerUnits="strokeWidth"
+ markerWidth="4"
+ markerHeight="3"
+ orient="auto">
+ <path d="M 10 0 L 0 5 L 10 10 z" />
+ </marker> </defs>
+<g>
+<path style="stroke:#5a5176; stroke-width:18.0; fill:#bdbaff" d="M 253.328 614.689C 182.584 613.866 95.1702 558.196 94.3352 471.647C 103.523 416.226 131.382 420.319 133.052 371.727C 133.052 371.727 164.792 424.115 172.31 470.429C 153.098 352.745 189.015 373.244 175.65 280.615C 175.65 280.615 212.928 323.852 222.115 398.259C 198.729 228.946 233.322 288.245 253.293 94.3352C 268.094 288.148 307.712 228.023 284.324 397.903C 293.512 323.248 330.79 279.866 330.79 279.866C 317.427 372.806 353.34 352.237 334.132 470.315C 341.649 423.845 373.387 371.281 373.387 371.281C 375.058 420.037 402.918 415.93 412.106 471.537C 411.271 558.375 324.071 613.864 253.328 614.689z"/>
+</g>
+</svg>
\ No newline at end of file
diff -rN -u old-fenfire-hs/fenfire.cabal new-fenfire-hs/fenfire.cabal
--- old-fenfire-hs/fenfire.cabal 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/fenfire.cabal 2007-03-11 15:52:00.000000000 +0200
@@ -13,16 +13,17 @@
Homepage: http://fenfire.org/
Build-Depends: base, HaXml, gtk > 0.9.10, mtl, unix, cairo, harp,
template-haskell, glib, network
-Data-Files: data/logo.svg data/icon16.png
+Exposed-Modules: Data.RDF, Data.RDF.Raptor
+Data-Files: data-files/logo.svg data-files/icon16.png
Executable: fenfire
Main-Is: Main.hs
-Other-Modules: Fenfire, Vobs, RDF, Cache, Cairo, Utils, Raptor, FunctorSugar,
+Other-Modules: Fenfire, Vobs, Data.RDF, Cache, Cairo, Utils, Data.RDF.Raptor, FunctorSugar,
GtkFixes, VanishingView, Main
GHC-Options: -fglasgow-exts -hide-package haskell98 -Wall
-fno-warn-unused-imports -fno-warn-missing-signatures
-fno-warn-orphans -main-is Main.main
-Extra-Libraries: raptor
+Extra-Libraries: Data.RDF.Raptor
Executable: functortest
Main-Is: FunctorTest.hs
diff -rN -u old-fenfire-hs/Main.hs new-fenfire-hs/Main.hs
--- old-fenfire-hs/Main.hs 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/Main.hs 2007-03-11 15:52:00.000000000 +0200
@@ -466,7 +466,7 @@
-- main window:
let ?pw = window in mdo
- logo <- getDataFileName "data/icon16.png"
+ logo <- getDataFileName "data-files/icon16.png"
Control.Exception.catch (windowSetIconFromFile window logo)
(\e -> putStr ("Opening "++logo++" failed: ") >> print e)
windowSetTitle window "Fenfire"
@@ -648,7 +648,7 @@
makeAboutDialog :: (?pw :: Window) => IO AboutDialog
makeAboutDialog = do
dialog <- aboutDialogNew
- logoFilename <- getDataFileName "data/logo.svg"
+ logoFilename <- getDataFileName "data-files/logo.svg"
pixbuf <- Control.Exception.catch (pixbufNewFromFile logoFilename)
(\e -> return $ Left (undefined, show e))
logo <- case pixbuf of Left (_,msg) -> do
diff -rN -u old-fenfire-hs/Raptor.chs new-fenfire-hs/Raptor.chs
--- old-fenfire-hs/Raptor.chs 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/Raptor.chs 1970-01-01 02:00:00.000000000 +0200
@@ -1,327 +0,0 @@
--- We want the C compiler to always check that types match:
-{-# OPTIONS_GHC -fvia-C #-}
-module 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/RDF.hs new-fenfire-hs/RDF.hs
--- old-fenfire-hs/RDF.hs 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/RDF.hs 1970-01-01 02:00:00.000000000 +0200
@@ -1,190 +0,0 @@
-module 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 Cache
-import 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/Utils.hs new-fenfire-hs/Utils.hs
--- old-fenfire-hs/Utils.hs 2007-03-11 15:52:00.000000000 +0200
+++ new-fenfire-hs/Utils.hs 2007-03-11 15:52:00.000000000 +0200
@@ -1,5 +1,5 @@
-- For (instance MonadReader w m => MonadReader w (MaybeT m)) in GHC 6.6:
-{-# OPTIONS_GHC -fallow-undecidable-instances #-}
+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}
module Utils where
-- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
More information about the Fencommits
mailing list