module ShouldSucceed where

-- import TheUtils
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List (partition )

data Digraph vertex = MkDigraph [vertex]

type Edge  vertex = (vertex, vertex)
type Cycle vertex = [vertex]

mkDigraph = MkDigraph

stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
stronglyConnComp es vs
  = snd (span_tree (new_range reversed_edges)
                    ([],[])
                   ( snd (dfs (new_range es) ([],[]) vs) )
         )
 where
   reversed_edges = map swap es

   swap :: Edge v -> Edge v
   swap (x,y) = (y, x)

   new_range    []       w = []
   new_range ((x,y):xys) w
        = if x==w
          then (y : (new_range xys w))
          else (new_range xys w)

   span_tree r (vs,ns) []   = (vs,ns)
   span_tree r (vs,ns) (x:xs)
        | x `elem` vs = span_tree r (vs,ns) xs
        | otherwise = span_tree r (vs',(x:ns'):ns) xs
          where
            (vs',ns') = dfs r (x:vs,[]) (r x)

dfs r (vs,ns)   []   = (vs,ns)
dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
                     | otherwise = dfs r (vs',(x:ns')++ns) xs
                                   where
                                     (vs',ns') = dfs r (x:vs,[]) (r x)


isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
isCyclic edges [v] = (v,v) `elem` edges
isCyclic edges vs = True


topSort :: (Eq vertex) => [Edge vertex] -> [vertex]
              -> MaybeErr [vertex] [[vertex]]


topSort edges vertices
 = case cycles of
        [] -> Succeeded [v | [v] <- singletons]
        _  -> Failed cycles
   where
   sccs = stronglyConnComp edges vertices
   (cycles, singletons) = partition (isCyclic edges) sccs


type FlattenedDependencyInfo vertex name code
   = [(vertex, Set name, Set name, code)]

mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]
mkVertices info = [ vertex | (vertex,_,_,_) <- info]

mkEdges :: (Ord name) =>
            [vertex]
         -> FlattenedDependencyInfo vertex name code
         -> [Edge vertex]

mkEdges vertices flat_info
 = [ (source_vertex, target_vertex)
   | (source_vertex, _, used_names, _) <- flat_info,
     target_name   <- Set.toList used_names,
     target_vertex <- vertices_defining target_name flat_info
   ]
 where
   vertices_defining name flat_info
    = [ vertex |  (vertex, names_defined, _, _) <- flat_info,
                name `Set.member` names_defined
      ]

lookupVertex :: (Eq vertex) =>
                 FlattenedDependencyInfo vertex name code
              -> vertex
              -> code

lookupVertex flat_info vertex
 = head code_list
 where
   code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']


isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool
isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges
isRecursiveCycle cycle    edges = True



-- may go to TheUtils

data MaybeErr a b = Succeeded a | Failed b