--
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
--                    Sean Seefried <http://www.cse.unsw.edu.au/~sseefried>
--                    Stefan Wehr   <http://www.stefanwehr.de>
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)
--

module Graph where

import Data.Maybe
import qualified Data.Map as M
import qualified Data.Graph.Inductive as Gr
import qualified Data.Graph.Inductive.Query.BFS as BFS


import Syntax   ( Location )
import Logging
import Data.List

--
-- the actual graph
--
type Graph = Gr.Gr GNodeLabel GEdgeLabel

type GPath = [GNode]
type GSimplePath = [GSimpleNode]

-- nodes only need their location string, not their coords
type GNodeLabel = Location
type GNode = Gr.LNode Location          -- (Gr.Node,Location)
type GSimpleNode = Gr.Node

-- edges store nothing
type GEdgeLabel = Int
gedgeLabel :: GEdgeLabel
gedgeLabel = 1

type GEdge = Gr.LEdge GEdgeLabel        -- (Int,Int,())

-- build a graph
mkGraph :: [GNode] -> [GEdge] -> Graph
mkGraph n e = Gr.mkGraph n e

------------------------------------------------------------------------
--
-- map location strings to actual nodes
--
type GNodeMap = M.Map Location GNode

class NM a where
    lookupNode :: Location -> a -> GNode

instance NM GNodeMap where
    lookupNode l m = 
        case M.lookup l m of
          Just n -> n
          Nothing -> niceError ("no node for location " ++ show l)

--
-- Functions on graphs, nodes and edges
--

locOfNode :: GNode -> Location
locOfNode (_, l) = l

simpleNode2node :: Graph -> GSimpleNode -> GNode
simpleNode2node g n = 
    case Gr.lab g n of
      Just x -> (n, x)
      Nothing -> niceError ("no location for node " ++ show n)

simplePath2path :: Graph -> GSimplePath -> GPath
simplePath2path g p = 
    map (simpleNode2node g) p

gsucc :: Graph -> GNode -> [GNode]
gsucc g n = 
    let succs = Gr.suc g (fst n)
        in map (simpleNode2node g) succs

gpred :: Graph -> GNode -> [GNode]
gpred g n =
    let preds = Gr.pre g (fst n)
        in map (simpleNode2node g) preds

gisEmpty :: Graph -> Bool
gisEmpty g = Gr.isEmpty g

gempty :: Graph
gempty = Gr.empty

------------------------------------------------------------------------
-- Queries
--
gshortestpath :: GNode -> GNode -> Graph -> GSimplePath
gshortestpath (n1,_) (n2,_) g = Gr.sp n1 n2 g

gshortestpath' :: GNode -> GNode -> Graph -> GPath
gshortestpath' n1 n2 g = simplePath2path g (gshortestpath n1 n2 g)

-- nodesWithin _ c 0 = [c]
-- nodesWithin g c n = (nub . concat . (map (gsucc g))) (nodesWithin g c n)

nodesWithin :: Graph -> GNode -> Int -> [GNode]
nodesWithin g (n,_) depth =
    let bfstree = BFS.level n g -- better be lazy..
        nodes   = takeWhile (\(_,i) -> i < depth) bfstree
    in map (\n -> simpleNode2node g (fst n)) nodes 

------------------------------------------------------------------------

--
-- This structure is lazy. It will be built on the first lookup.
-- So we may wish to force this value in the world skel phase, so we
-- know the cost of its building is done.
--
-- If lookup is too slow, we could construct an array, rather than a Map
--
-- If construction is too slow, switch to Floyd-Warshall, for example
--
allShortestPaths :: Graph -> SPMap
allShortestPaths g = 
    M.fromList [ ((mksn n,mksn m), mksp (Gr.sp n m g)) | n <- allnodes, m <- allnodes ]
    where
        allnodes = Gr.nodes g
        mksn     = simpleNode2node g
        mksp     = simplePath2path g

type SPMap = M.Map (GNode,GNode) [GNode]

--
-- find the shortest path from our precomputed table. 
-- empty list if no path exists
--
fastShortestPath :: GNode -> GNode -> SPMap -> [GNode]
fastShortestPath n1 n2 m = fromMaybe [] (M.lookup (n1,n2) m)