module Pangraph (
Pangraph, Edge, Vertex, Attribute,
Key, Value, VertexID, EdgeID,
makePangraph, makeEdge, makeVertex,
edgeList, vertexList, lookupVertex, lookupEdge,
edgeAttributes, vertexAttributes,
edgeEndpoints, edgeID, vertexID
) where
import Data.Maybe (mapMaybe)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Algebra.Graph.Class as Alga
data Pangraph = Pangraph
{ vertices' :: Map VertexID Vertex
, edges' :: Map EdgeID Edge
} deriving (Eq)
data Vertex = Vertex
{ vertexID' :: VertexID
, vertexAttributes' :: [Attribute]
} deriving (Eq)
data Edge = Edge
{ edgeID' :: Maybe EdgeID
, edgeAttributes' :: [Attribute]
, endpoints' :: (Vertex, Vertex)
} deriving (Eq)
type EdgeID = Int
type VertexID = BS.ByteString
type Attribute = (Key, Value)
type Key = BS.ByteString
type Value = BS.ByteString
type MalformedEdge = (Edge, (Maybe Vertex, Maybe Vertex))
instance Show Pangraph where
show p = "makePangraph " ++ show (Map.elems (vertices' p)) ++ " " ++ show (Map.elems (edges' p))
instance Show Vertex where
show (Vertex i as) = unwords ["makeVertex", show i, show as]
instance Show Edge where
show (Edge _ as e) = unwords ["makeEdge", show as, show e]
instance Alga.ToGraph Pangraph where
type ToVertex Pangraph = Vertex
toGraph p = Alga.graph (vertexList p) (map edgeEndpoints $ edgeList p)
makePangraph :: [Vertex] -> [Edge] -> Maybe Pangraph
makePangraph vs es = case verifyGraph vertexMap es of
[] -> Just $ Pangraph vertexMap edgeMap
_ -> Nothing
where
vertexMap :: Map VertexID Vertex
vertexMap = Map.fromList $ zip (map vertexID vs) vs
edgeMap :: Map EdgeID Edge
edgeMap = Map.fromList indexEdges
indexEdges :: [(EdgeID, Edge)]
indexEdges = map (\ (i, Edge _ as a) -> (i, Edge (Just i) as a )) $ zip [0..] es
verifyGraph :: Map VertexID Vertex -> [Edge] -> [MalformedEdge]
verifyGraph vs = mapMaybe (\e -> lookupEndpoints (e, edgeEndpoints e))
where
lookupEndpoints :: (Edge, (Vertex, Vertex)) -> Maybe MalformedEdge
lookupEndpoints (e, (v1,v2)) =
case (Map.lookup (vertexID v1) vs, Map.lookup (vertexID v2) vs) of
(Just _ , Just _) -> Nothing
(Nothing, Just _) -> Just (e, (Just v1, Nothing))
(Just _ , Nothing) -> Just (e, (Nothing, Just v2))
(Nothing, Nothing) -> Just (e, (Just v1, Just v2))
makeEdge :: [Attribute] -> (Vertex, Vertex) -> Edge
makeEdge = Edge Nothing
makeVertex :: VertexID -> [Attribute] -> Vertex
makeVertex = Vertex
edgeList :: Pangraph -> [Edge]
edgeList p = Map.elems $ edges' p
vertexList :: Pangraph -> [Vertex]
vertexList p = Map.elems $ vertices' p
lookupEdge :: EdgeID -> Pangraph -> Maybe Edge
lookupEdge key p = Map.lookup key $ edges' p
lookupVertex :: VertexID -> Pangraph -> Maybe Vertex
lookupVertex key p = Map.lookup key $ vertices' p
edgeAttributes :: Edge -> [Attribute]
edgeAttributes = edgeAttributes'
vertexAttributes :: Vertex -> [Attribute]
vertexAttributes = vertexAttributes'
edgeEndpoints :: Edge -> (Vertex, Vertex)
edgeEndpoints = endpoints'
edgeID :: Edge -> Maybe EdgeID
edgeID = edgeID'
vertexID :: Vertex -> VertexID
vertexID = vertexID'