Load.hs

module HGraph.Directed.Load
       ( loadDot
       , loadEdgeList
       )
where

import HGraph.Directed
import HGraph.Utils
import qualified Language.Dot.Parser as D
import qualified Language.Dot.Utils as D
import qualified Language.Dot.Graph  as D
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import Text.Read

loadDot emptyD dotStr = do
  dot <- D.parse dotStr
  return $ 
    let (ns, es) = D.adjacency dot
        names = (S.toList $ S.fromList $ map getNodeName ns)
        nid = M.fromList $ zip names ([0..] :: [Int])
        idToStr = M.fromList $ zip ([0..] :: [Int]) names
        addEdge (D.Edge v u _) d = addArc (nid M.! v, nid M.! u) d
        getNodeName (D.Node name _) = name
        nodeAttrMap = M.fromList [ (v, attrs) | D.Node v attrs <- ns]
        edgeAttrMap = M.fromList [ ((v,u), attrs) | D.Edge v u attrs <- es]
    in (foldr addEdge (foldr addVertex emptyD $ M.keys idToStr) es, nid, idToStr, nodeAttrMap, edgeAttrMap)

loadEdgeList emptyD dStr
  | null terms = return emptyD
  | otherwise = do
    nv <- fromMaybe (Left "Invalid number of vertices.") $ do
          t0 <- mhead terms
          n <- readMaybe t0
          if n < 1 then Nothing else return $ Right n
    ne <- fromMaybe (Left "Invalid number of edges.") $ do
          t0 <- mhead $ drop 1 terms
          e <- readMaybe t0
          if e < 0 then Nothing else return $ Right e
    es <- readEdges nv $ drop 2 terms
    if ne /= (length es) then
      Left $ "Expected " ++ (show ne) ++ " many edges, found " ++ (show $ length es) ++ "."
    else
      return $ foldr addArc (foldr addVertex emptyD [0..nv - 1]) es
  where
    terms = words dStr
    readEdges _ [] = return []
    readEdges _ [_] = Left "Missing tail of last edge."
    readEdges nv (vStr:uStr:vs) = do
      v <- fromMaybe (Left $ "Invalid vertex: " ++ vStr) $ fmap Right $ readMaybe vStr
      u <- fromMaybe (Left $ "Invalid vertex: " ++ uStr) $ fmap Right $ readMaybe uStr
      fmap ((v `mod` nv, u `mod` nv) : ) (readEdges nv vs)