packages feed

mathgenealogy-0.0.1: Graph.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Graph
-- Copyright   :  (C) Peter Robinson 2010-2012
-- License     :  GPL-2
--
-- Maintainer  :  Peter Robinson <thaldyron@gmail.com>
-- Stability   :  experimental
-- Portability :  portable 
--
-----------------------------------------------------------------------------
module Graph
where
import qualified Data.Map as M
import Data.Graph.Inductive
import Data.Text.Lazy(Text)
import qualified Data.Text.Lazy as T
import Entry

-- | Maps scientist names to Entries
type EntryMap = M.Map Text Entry

mkEntryMap :: [Entry] -> EntryMap -> EntryMap
mkEntryMap es theMap = foldl (\theMap e -> M.insert (entryName e) e theMap) theMap es


entryGraph :: [Entry] -> Gr Entry ()
entryGraph es = entryEdges es (entryNodes es)


entryNodes :: [Entry] -> Gr Entry ()
entryNodes = foldr (\e g -> insNode (head (newNodes 1 g),e) g) (empty :: Gr Entry ())


entryEdges :: [Entry] -> Gr Entry () ->  Gr Entry ()
entryEdges entries graph = 
  let nodeMap :: M.Map Entry Int
      nodeMap = M.fromList $ map (\(a,b) -> (b,a)) $ labNodes graph
      theMap = mkEntryMap entries M.empty
  in  foldr (\e g -> 
    insEdges [(M.findWithDefault (error "Error - This should never happen.") e nodeMap
              ,M.findWithDefault undefined (M.findWithDefault 
                  (error ("Error - This should never happen. Failed while looking up " 
                    ++show adv ++ show theMap ++ show nodeMap)) adv theMap) nodeMap,())
             | adv <- map fst $ entryAdvisors e
             ] g) graph entries