{-# LANGUAGE DeriveGeneric
, DeriveAnyClass
#-}
module Data.RDF.Graph (
GNode(..)
, GEdge
, rdfGraph
, triplesGraph
, graphRDF
, graphTriples
) where
import Control.DeepSeq
import qualified Data.Graph.Inductive.Graph as G
import qualified Data.Graph.Inductive.NodeMap as G
import Data.Maybe
import Data.RDF.Types
import GHC.Generics
data GNode = IRIGNode !IRI
| BlankGNode !BlankNode
| LiteralGNode !Literal
deriving ( Eq
, Ord
, Read
, Show
, Generic
, NFData
)
type GEdge = Predicate
subjectNode :: Subject -> GNode
subjectNode (IRISubject i) = IRIGNode i
subjectNode (BlankSubject b) = BlankGNode b
objectNode :: Object -> GNode
objectNode (IRIObject i) = IRIGNode i
objectNode (BlankObject b) = BlankGNode b
objectNode (LiteralObject l) = LiteralGNode l
nodeSubject :: GNode -> Either String Subject
nodeSubject (IRIGNode i) = Right (IRISubject i)
nodeSubject (BlankGNode b) = Right (BlankSubject b)
nodeSubject _ = Left "nodeSubject: subject must IRI or blank node."
nodeObject :: GNode -> Object
nodeObject (IRIGNode i) = IRIObject i
nodeObject (BlankGNode b) = BlankObject b
nodeObject (LiteralGNode l) = LiteralObject l
rdfGraph :: G.DynGraph g => RDFGraph -> (g GNode GEdge, G.NodeMap GNode)
rdfGraph (RDFGraph _ ts) = triplesGraph ts
triplesGraph :: G.DynGraph g => [Triple] -> (g GNode GEdge, G.NodeMap GNode)
triplesGraph triples = G.mkMapGraph nodes edges
where (nodes, edges) = go ([],[]) triples
go (ns, es) [] = (ns, es)
go (ns, es) (Triple s p o:ts) = let s' = subjectNode s
o' = objectNode o
in go (s':o':ns, (s', o', p):es) ts
graphRDF :: G.Graph g => Maybe IRI -> g GNode GEdge -> Either String RDFGraph
graphRDF l = (RDFGraph l <$>) . graphTriples
graphTriples :: G.Graph g => g GNode GEdge -> Either String [Triple]
graphTriples g = go (G.labEdges g)
where go [] = Right []
go ((si, oi, p):ts) = let s = nodeSubject (fromJust (G.lab g si))
o = nodeObject (fromJust (G.lab g oi))
in ((\s' -> (Triple s' p o:)) <$> s) <*> go ts