content: module GraphUtil (
                    extractOneCycle,
                    extractOneCycle_gmap,
                    extractOneCycle_map,
                    findPathEdges,
                    reverseMap
                    ) where
  
  -- ==================================================
  -- GraphUtil
  --
  -- These are useful functions which span more than one
  -- type of graph (GraphMap, Data.Graph, etc)
  --
  -- ==================================================
  
  import Data.Maybe(isJust)
  
  import Util(tailOrErr, initOrErr)
  import ErrorUtil
  import PPrint
  
  import qualified GraphMap as G
  import qualified GraphWrapper as GW
  
  import qualified Data.Map as M
  
  import System.IO.Unsafe
  
  -- ===============
  
  -- find one cyclic (non-repeating) path in the SCC
  extractOneCycle :: (Ord nodeT, PPrint nodeT) =>
                     [(nodeT,nodeT)] -> [nodeT] -> [nodeT]
  extractOneCycle edges cycle@(a:b:_) =
      let nodes = cycle
          g = unsafePerformIO (GW.makeGraph nodes edges)
  
          intErr s = internalError ("extractOneCyle: " ++ s)
  
          findPath x y =
              case (GW.findReachables g [x]) of
                  [ps] -> case (lookup y ps) of
                              Just path -> reverse path
                              Nothing -> intErr ("lookup: " ++ ppReadable ps)
                  x -> intErr ("reachables: " ++ ppReadable x)
  
          path_a_to_b = findPath a b
          path_b_to_a = findPath b a
          -- join the two paths, but with no duplicate node b in the middle
          cycle_path =
              path_a_to_b ++
              tailOrErr ("extractOneCycle: path_b_to_a does not contain b:"
                         ++ ppReadable path_b_to_a)
                        path_b_to_a
      in  cycle_path
  extractOneCycle _ [a] = [a] -- a cycle from a node to itself
  extractOneCycle _ [] =
      internalError ("extractOneCycle: cycle has no nodes")
  
  
  -- extract a cycle given a GraphMap
  extractOneCycle_gmap :: (Ord nodeT, PPrint nodeT) =>
                          G.GraphMap nodeT edgeT -> [nodeT] -> [nodeT]
  extractOneCycle_gmap gmap cycle =
      let edges = [ (r, r') | r <- cycle, r' <- cycle, r' /= r,
                              isJust (G.lookup (r,r') gmap) ]
      in  extractOneCycle edges cycle
  
  
  -- extract a cycle given a Map
  extractOneCycle_map :: (Ord nodeT, PPrint nodeT) =>
                         M.Map nodeT [nodeT] -> [nodeT] -> [nodeT]
  extractOneCycle_map m cycle =
      let edges = [ (r, r') | r <- cycle,
                              let rs = M.findWithDefault [] r m,
                              r' <- rs,
                              r' `elem` cycle ]
      in  extractOneCycle edges cycle
  
  
  -- ===============
  
  -- Given a list of nodes in a circular path (where the start and end
  -- nodes in the list are the same), this returns a list of pairs of
  -- nodes in the path along with the edge for that pair (from the GraphMap).
  findPathEdges :: (Ord nodeT, PPrint nodeT) =>
                   G.GraphMap nodeT edgeT -> [nodeT] ->
                   [((nodeT, nodeT), edgeT)]
  findPathEdges gmap path =
      let
          -- the path without the start node (which is same as the end)
          path_minus_start =
              tailOrErr
                  ("findPathEdges: path_minus_start" ++ ppReadable path)
                  path
          -- the path without the end node (which is same as the start)
          path_minus_end =
              initOrErr
                  ("findPathEdges: path_minus_end: " ++ ppReadable path)
                  path
          -- all the edges in the circular path
          path_pairs = zip path_minus_end path_minus_start
          -- lookup which shouldn't fail
          getEdge pair =
              case (G.lookup pair gmap) of
                  Nothing -> internalError ("findPathEdges: lookup failed: " ++
                                            ppReadable pair)
                  Just edge -> (pair,edge)
      in
          map getEdge path_pairs
  
  
  -- ===============
  
  -- takes a list of edges (of any kind) and produces a reverse map
  reverseMap :: (Ord a) => M.Map a [a] -> M.Map a [a]
  reverseMap m =
      let edges = M.toList m
          startEdge (e1,_) = (e1, [])
          reverseEdge (e1,es) = [(e2,[e1]) | e2 <- es]
          -- make sure that the map has "[]" for nodes with no ingoing edges
          -- XXX alternatively, users of this map could treat lookup failure
          -- XXX as meaning the empty list
          rev_edges = map startEdge edges ++
                      concatMap reverseEdge edges
      in M.fromListWith (++) rev_edges
  
  -- ===============
  