module Data.Graph.Analysis.Internal where
import Data.Graph.Inductive.Graph
import Data.Either(partitionEithers)
import qualified Data.Map as M
import Data.Map(Map)
import Data.Maybe(fromJust)
import Control.Arrow((***))
import Control.Monad(ap)
sq :: (Num a) => a -> a
sq x = x * x
fI :: (Num a) => Int -> a
fI = fromIntegral
swap :: (a,b) -> (b,a)
swap (a,b) = (b,a)
applyBoth :: (a -> b) -> (a,a) -> (b,b)
applyBoth f = f *** f
mkNodeMap :: (Ord a) => [LNode a] -> Map a Node
mkNodeMap = M.fromList . map swap
type Rel n e = (n, n, e)
applyNodes :: (a -> b) -> Rel a e -> Rel b e
applyNodes f (n1, n2, e) = (f n1, f n2, e)
fromNode :: Rel n e -> n
fromNode (n1, _, _) = n1
toNode :: Rel n e -> n
toNode (_, n2, _) = n2
relLabel :: Rel n e -> e
relLabel (_, _, e) = e
relsToEs :: (Ord a) => Bool -> [LNode a] -> [Rel a e]
-> ([Rel a e], [LEdge e])
relsToEs isDir lns rs = (unRs, graphEdges)
where
nodeMap = mkNodeMap lns
findNode v = M.lookup v nodeMap
validEdge e = case applyNodes findNode e of
(Just x, Just y, l) -> Right (x,y,l)
_ -> Left e
(unRs, gEdges) = partitionEithers $ map validEdge rs
dupSwap' = if isDir
then id
else concatMap dupSwap
dupSwap e@(x,y,l) | x == y = [e]
| otherwise = [e, (y,x,l)]
graphEdges = dupSwap' gEdges
addLabels :: (Graph g) => g a b -> [Node] -> [LNode a]
addLabels gr = map (ap (,) (fromJust . lab gr))