import MapGraph
import Control.Arrow ((***))
import Data.List (minimumBy, nub)
import Data.Function (on)

-- DATA
data RD = RD { rname :: String
             , rtype :: String
             , rsafety :: Int
             } deriving (Show, Ord, Eq)
                            
data CN = CN { cname :: String
             , ctype :: String
             , csafety :: Int
             } deriving (Show, Ord, Eq)
                                        
type Route = ([RD], [CN])

type RoadNetwork = Graph Int CN RD

-- FUNCTIONS
traverseRoute :: Route -> [String]
traverseRoute (r, c) = case (r, c) of
  ([],[]) -> []
  ([], c) -> connection c : traverseRoute theRest
  (r, []) -> road r : traverseRoute theRest
  (r, c) -> road r : connection c : traverseRoute theRest
  where
    road = rname . head
    connection = cname . head
    theRest = (stail r, stail c)
    stail [] = []
    stail (x:xs) = xs

createRoute :: Int -> Int -> RoadNetwork -> ([Edge Int RD],[Vertex CN])
createRoute s e g = if s == e
                    then ([lookupEdge g s],[])
                    else createRoute' s e g ([lookupEdge g s],[]) 
  where
    createRoute' :: Int -> Int -> RoadNetwork -> ([Edge Int RD],[Vertex CN]) -> ([Edge Int RD],[Vertex CN])
    createRoute' s e g (r, c) = if s == e
                                then (r, c)
                                else createRoute' s' e g (r', c')
      where
        c' = c ++ [snd (evaluateEdge s g)]
        r' = r ++ [head (outgoingEdges' (last c') g)]
        s' = keyOfEdge (last r') g

getRoute :: Int -> Int -> RoadNetwork -> [String] 
getRoute s e g = traverseRoute ((map fromEdge *** map fromVertex) route)
  where
    route = createRoute s e g

data Path = Path { pcost :: Int
                 , proads :: [Edge Int RD]
                 , pconnections :: [Vertex CN]
                 } deriving (Show, Ord, Eq)

createPath :: Edge Int RD -> Vertex CN -> Path -> Path
createPath e c p = Path (pcost p + rsafety (fromEdge e) + csafety (fromVertex c)) (nub $ proads p ++ [e]) (nub $ pconnections p ++ [c]) 

pathsFromConnection :: Vertex CN -> RoadNetwork -> Path -> [Path]
pathsFromConnection c rn p = map (\e -> createPath e c p) (outgoingEdges' c rn)

pickMinimum :: [Path] -> Path
pickMinimum = minimumBy (compare `on` pcost)
    
pathEndWith :: Path -> Edge Int RD -> Bool    
pathEndWith p e = e == last (proads p)

pathToPaths :: Path -> RoadNetwork -> [Path]
pathToPaths p rn = if pconnections p /= []
                   then pathsFromConnection (snd $ evaluateEdge' (edge p) rn) rn p
                   else [p]
  where
    edge = last . proads
    
    
pickOrExpand :: [Path] -> Edge Int RD -> RoadNetwork -> Path
pickOrExpand ps e rn = if s /= []
                       then pickMinimum s
                       else pickOrExpand (concatMap (`pathToPaths` rn) ps) e rn
  where
    s = filter (`pathEndWith` e) ps
    
shortestPath :: Int -> Int -> RoadNetwork -> Path
shortestPath s e rn = if s == e
                      then Path 0 [se] []
                      else pickOrExpand (pathToPaths (createPath se cs (Path 0 [] [])) rn) ee rn
  where
    se = lookupEdge rn s
    ee = lookupEdge rn e
    cs = snd (evaluateEdge s rn)

traversePath :: Path -> [String]
traversePath (Path s r c) = case (s,r,c) of 
  (_,[],[]) -> []
  (s,r,[]) -> [road r] ++ traversePath theRest
  (s,[],c) -> [connection c] ++ traversePath theRest
  (s,r,c) -> [road r] ++ [connection c] ++ traversePath theRest
  where
    road = rname . fromEdge . head
    connection = cname . fromVertex . head
    theRest = Path s (stail r) (stail c)
    stail [] = []
    stail (x:xs) = xs


-- TEST DATA --
c0 = CN "Nulte" "C" 7
c1 = CN "Første" "C" 3
c2 = CN "Anden" "C" 4
c3 = CN "Tredje" "C" 5
c4 = CN "Fjerde" "C" 1
c5 = CN "Femte" "C" 2
c6 = CN "Sjette" "C" 6
c7 = CN "Syvende" "C" 8

r1 = RD "First" "R" 6
r2 = RD "Second" "R" 3
r3 = RD "Thirth" "R" 8
r4 = RD "Fourth" "R" 2
r5 = RD "Fifth" "R" 5
r6 = RD "Sixth" "R" 1
r7 = RD "Seventh" "R" 4
r8 = RD "Eight" "R" 7
r9 = RD "Nineth" "R" 10
r10 = RD "Tenth" "R" 9

rn :: RoadNetwork
rn = buildGraph [(0,c0),(1,c1),(2,c2),(3,c3),(4,c4),(5,c5),(6,c6),(7,c7)] [(1,0,1,r1),(2,1,2,r2),(3,1,3,r3),(4,2,5,r4),(5,3,4,r5),(6,2,4,r6),(7,3,5,r7),(8,5,6,r8),(9,4,6,r9),(10,6,7,r10)]
-- END TEST DATA --