content: module Graph where
  
  import qualified Data.Set as S
  import qualified Data.Map as M
  import Data.Maybe
  import Control.Monad
  import Control.Monad.State
  
  data G a = Node  a (G a) (G a)
           | Leaf  a
           | Nil deriving (Show)
  
  type LoopCheck a = S.Set a
  
  
  {- Actually i am not sure about the cata and algebra definition.
   -  
   -  ** check: http://dl.acm.org/citation.cfm?id=128035
   -}
  
  -- Represents an acumulator
  type TreeAlgebra a r = (a -> r, r -> r -> r)
  
  foldG :: TreeAlgebra a r -> r -> G a -> r
  foldG (f,g) s (Leaf val)     = g (f val) s
  foldG (f,g) s (Node val l r) = g (f val) $ g (foldG (f,g) s l) (foldG (f,g) s r)
                          
  printG = foldG ((: []), (++)) []
  
  loopCheck :: (Ord k) => G a -> (G a -> k) -> State (LoopCheck k) Bool
  loopCheck g f = do state <- get
                     return $ S.member (f g) state
  
  addNode :: (Ord k) => k -> State (LoopCheck k) ()
  addNode k = do s <- get 
                 put $ S.insert k s
                 return ()
  
  foldGM :: (Ord k) => TreeAlgebra a r -> (G a -> k) -> r -> G a -> State (LoopCheck k) r
  foldGM _     _ s    Nil           = return s
  foldGM (f,g) c s k@(Leaf val)     = loopCheck k c >>= \p -> if p then return s else return $ g (f val) s
  foldGM (f,g) c s k@(Node val l r) = loopCheck k c >>= \p -> if p then return s else continue
                                      where t        = foldGM (f,g) c s
                                            self     = g (f val)
                                            continue = do addNode $ c k
                                                          left  <- t l
                                                          right <- t r
                                                          return $ self $ g left right
  
  -- Generates a node from a list of children.
  packNodes :: [G a] -> a -> G a
  packNodes (x:y:[]) e = Node e x y    -- full binary
  packNodes (x:[]  ) e = Node e x Nil  -- unary
  packNodes []       e = Leaf e        -- leaf
  
  -- Generates a cyclic datastructure given edges and nodes
  -- TODO: remove lists with maps in inputs
  toG :: (Ord k,Show k) => ([r] -> a -> r) -> [(k,[k])] -> k -> [(k, a)] -> Maybe r
  toG g xs start pls = let nodeTable = M.fromList pls
                           payload s = case M.lookup s nodeTable of
                                         Just x  -> x
                                         Nothing -> error "edge with no corresponding node"
  
                           conn = M.fromList $ map (
                                    \(f,ts) -> let pl t = node f (payload t) t
                                                   succ = map pl ts
                                              in (f, g succ (payload f))
                                   ) xs
  
                           node f p t = case M.lookup t conn of
                                              (Just x) -> x
                                              Nothing  
                                                -> error $ "illformed edge/node list in toG" ++ (show t)
                     in M.lookup start conn
  
  
  
  testG = [(0,[1,2]),(1,[3]),(2,[0]),(3,[])]
  nodeLoads :: [(Int,String)]
  nodeLoads = [(0,"a"),(1,"b"),(2,"c"),(3,"d")]
  
  
  
  