{-# LANGUAGE OverloadedStrings #-}
module Pangraph.Internal.ProtoGraph
( ProtoVertex()
, ProtoEdge()
, makeProtoVertex
, makeProtoEdge
, protoVertexAttributes
, protoEdgeAttributes
, BuildPangraph()
, buildPangraph
, getProtoEdge
, getProtoVertex
) where
import Pangraph
class BuildPangraph t where
getProtoVertex :: t -> [ProtoVertex]
getProtoEdge :: t -> [ProtoEdge]
newtype ProtoGraphStage1 = ProtoGraphStage1 (Maybe Pangraph)
deriving (Eq)
newtype ProtoGraphStage2 = ProtoGraphStage2 (Maybe Pangraph)
deriving (Eq)
newtype ProtoEdge = ProtoEdge [Attribute]
deriving (Eq)
newtype ProtoVertex = ProtoVertex [Attribute]
deriving (Eq)
instance Show ProtoVertex where
show (ProtoVertex as) = unwords ["makeProtoVertex", show as]
instance Show ProtoEdge where
show (ProtoEdge as) = unwords ["makeProtoEdge", show as]
buildPangraph :: BuildPangraph t => t -> (ProtoVertex -> VertexID) -> (ProtoEdge -> (VertexID, VertexID)) -> Maybe Pangraph
buildPangraph t vf ef = let
vs = getProtoVertex t
es = getProtoEdge t
stage1 = makeProtoGraphStage1 vs vf
(ProtoGraphStage2 p) = makeProtoGraphStage2 stage1 es ef
in p
makeProtoGraphStage1 :: [ProtoVertex] -> (ProtoVertex -> VertexID) -> ProtoGraphStage1
makeProtoGraphStage1 vs f = let
vertices :: [Vertex]
vertices = map (toVertex f) vs
toVertex fv v = makeVertex (fv v) (protoVertexAttributes v)
in (ProtoGraphStage1 . (\ a -> makePangraph a [])) vertices
makeProtoGraphStage2 :: ProtoGraphStage1 -> [ProtoEdge] -> (ProtoEdge -> (VertexID, VertexID)) -> ProtoGraphStage2
makeProtoGraphStage2 (ProtoGraphStage1 p) protoEdges ef = let
es = map (toEdge ef) protoEdges
toEdge fe e = makeEdge (fe e) (protoEdgeAttributes e)
s2 = fmap vertexList p >>= \ vs -> makePangraph vs es
in ProtoGraphStage2 s2
makeProtoEdge :: [Attribute] -> ProtoEdge
makeProtoEdge = ProtoEdge
makeProtoVertex :: [Attribute] -> ProtoVertex
makeProtoVertex = ProtoVertex
protoEdgeAttributes :: ProtoEdge -> [Attribute]
protoEdgeAttributes (ProtoEdge as) = as
protoVertexAttributes :: ProtoVertex -> [Attribute]
protoVertexAttributes (ProtoVertex as) = as